2 кода вместе с vba? за каждое утверждение слишком большое

Question

Мне нужно выполнить задачу для моей работы. Я новичок в VBA-Excel, поэтому я застрял. Это тоже мой первый пост, поэтому заранее прошу прощения.

Как видите, это код, который я сделал, чтобы я мог получить свои счета из списка. Есть еще некоторые вещи, такие как форматирование всего этого. Но для меня самая важная часть - это объединить другой лист с этим кодом, как тот же самый точный код. Мне нужен цикл, который делает мне 1-й этот код, а затем второй код, который похож.

Что-то вроде:

Для каждого идентификатора, который совпадает с 2 списками, сделайте мне файл PDF со всеми счетами и всеми суммами.

Проблема в том, что я заблудился во всем кодировании, потому что у меня такое чувство, что для каждого утверждения становится 3 страницы, что, я полагаю, не может быть правильным.

Мой код как есть:

Sub Schleife()

    Dim Zeile As Long
    Dim ZeileMax As Long
    Dim n As Long
    Dim m As Long
    Dim a As Long
    Dim strSpalte As String
    Dim strSpalte1 As String
    Dim strBereich As String
    Dim L As Long
    Dim R As Long
    Dim AR As Range
    Dim Le As Long
    Dim i As Long
    Dim arrBlätter() As String
    Dim leereZelle As Long
    Dim strSpalte2 As String
    Dim strSpalte3 As String
    Dim strBereich2 As String


    'Worksheets
    Dim dl As Worksheet: Set dl = ActiveWorkbook.Sheets("DatenLadevorgänge")
    Dim lv As Worksheet: Set lv = ActiveWorkbook.Sheets("Ladevorgänge")
    Dim üb As Worksheet: Set üb = ActiveWorkbook.Sheets("Übersicht")
    Dim de As Worksheet: Set de = ActiveWorkbook.Sheets("DatenERoaming")
    Dim ge As Worksheet: Set ge = ActiveWorkbook.Sheets("Geräte")
    Dim ch As Worksheet: Set ch = ActiveWorkbook.Sheets("Chips")
    Dim eR As Worksheet: Set eR = ActiveWorkbook.Sheets("eRoaming")
    Dim mv As Worksheet: Set mv = ActiveWorkbook.Sheets("MEC-Verträge")
    Dim lastrow As Long

    Application.ScreenUpdating = True

    leereZelle = Columns(11).Find(What:="", Lookat:=xlWhole, Searchdirection:=xlNext).Row

    With Tabelle1
        If .Cells(leereZelle, 11) = "" Then üb.Cells(1, 1).Value = mv.Cells(leereZelle, 1).Value
    End With

    lv.Select
    lv.Range("A10:O100000").ClearContents
    üb.Range("A53:M100000").ClearContents

    With dl

        ZeileMax = .UsedRange.Rows.Count         'Fkt zur Aufuschung aller SmartCables'
        n = 10

        For Zeile = 2 To ZeileMax

            If .Cells(Zeile, 13).Value = lv.Range("A1").Value Then
                .Range(dl.Cells(Zeile, 2), dl.Cells(Zeile, 12)).Copy _
                Destination:=lv.Range(lv.Cells(n, 2), lv.Cells(n, 12))
                n = n + 1
            End If

        Next Zeile

        lastrow = Cells(Rows.Count, 2).End(xlUp).Row
        'Sortieren
        .Range("B10:L" & lastrow).Sort Key1:=.Range("B10:B" & lastrow), _
                                       Order1:=xlAscending, Key2:=.Range("C10:C" & lastrow), Order2:=xlAscending

        dl.Range("B10", dl.Range(dl.Cells(10, 2), dl.Cells(n, 13))).RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo

    End With


    L = Range("B65000").End(xlUp).Row
    strBereich = "A10:O" & L
    strSpalte = "B"
    strSpalte1 = "O"

    If Range("B10") = "" Then
        Cells(10, 2).Value = "Keine Ladevorgänge vorhanden"
    Else
        lv.Range(strBereich).Sort _
        Key1:=Range(strSpalte & "1"), Order1:=xlAscending, Key2:=Range(strSpalte1 & "1"), Order2:=xlAscending, _
                                                                       Header:=xlNo
        lv.Range("I" & L + 1) = WorksheetFunction.Sum(Range("I10:I" & L))
        lv.Range("J" & L + 1) = WorksheetFunction.Sum(Range("J10:J" & L))
        lv.Range("K" & L + 1) = WorksheetFunction.Sum(Range("K10:K" & L))
        lv.Range("L" & L + 1) = WorksheetFunction.Sum(Range("L10:L" & L))
        lv.Range("B" & L + 1).Value = "Gesamtsumme"
    End If

    lv.Range("C1").Value = "$B$2:$L$" & L + 1

    üb.Select

    With ge

        ZeileMax = .UsedRange.Rows.Count
        n = 66

        For Zeile = 2 To ZeileMax
            If ge.Cells(Zeile, 1).Value = üb.Cells(1, 1) Then
                .Rows(Zeile).Copy Destination:=üb.Rows(n)
                n = n + 1
            End If
        Next Zeile

    End With

    R = Range("B65000").End(xlUp).Row
    strBereich = "A53:M" & R
    strSpalte = "B"
    üb.Range(strBereich).Sort Key1:=Range(strSpalte & "1"), Order1:=xlAscending, Header:=xlNo

    mv.Select

    With mv
        .Cells(leereZelle, 11).Value = "ja"
        üb.Cells(36, 10).Value = .Cells(leereZelle, 10).Value
    End With

End Sub