2 codes together with vba ? for each statement too big - vba

Question

I need to to complete a task for my work. I am new to VBA-Excel so I am kind of stuck. This is also my first post so i am sorry in advance.
As you can see, this is a code I made so that i can get my invoices from a list. There are still some things missing like formatting all of it. But for me the most important part is to combine another worksheet with this code like the same exact code. I need a loop that does me 1st this code and then the second code which is similar.
Something like:
For each ID that is the same of the 2 lists do me a pdf file with all the invoices and all the sums.
The problem is that i get lost in all the coding because i have the feeling my for each statement is getting like 3 pages long which cannot be correct i assume.
My code as is:
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