Hallo,

mein vba code läuft geht nicht. kann mir jmd. bitte helfen.
Ich möchte gerne nach meinen vorgaben sortiert haben.



Dim LoI As Long ' 1. Schleifenvariable
Dim LoJ As Long ' 2. Schleifenvariable
Dim LoLetzte1 As Long ' Variable letzte Zeile in Spalte A
Dim LoLetzte2 As Long ' Variable letzte Zeile in Spalte B
Dim Loletzte3 As Long ' Variable letzte Zeile in Tabelle3
Application.ScreenUpdating = False ' Bildschirmaktualisierung aus
With Worksheets("Abrechnung").Range("IU65484:IU65520") ' letzte Zeile in Spalte A Tabelle1
LoLetzte1 = IIf(IsEmpty(.Cells(Rows.Count, 2)), .Cells(Rows.Count, 2).End(xlUp).Row, .Rows.Count)
End With
With Worksheets("Tabelle2") ' letzte Zeile in Spalte B Tabelle2
LoLetzte2 = IIf(IsEmpty(.Cells(Rows.Count, 2)), .Cells(Rows.Count, 2).End(xlUp).Row, .Rows.Count)
End With
For LoI = 1 To LoLetzte1 ' 1. Schleife alle Werte Spalte A
For LoJ = 1 To LoLetzte2 ' 2. Schleife alle Werte Spalte B
If Worksheets("Tabelle1").Cells(LoI, 1) <> "" Then ' Leerzellen nicht kennzeichnen
If Worksheets("Tabelle1").Cells(LoI, 1) = Worksheets("Tabelle2").Cells(LoJ, 2) Then
Worksheets("Tabelle1").Rows(LoI).Copy ' Zellen sind gleich, Zeile Kopieren
With Worksheets("Tabelle3")
' letzte belegte Zeile in Tabelle3 ermitteln
Loletzte3 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1
If Loletzte3 > Rows.Count Then ' ermittelte Zeilennummer mit max. Anzahl vergleichen
MsgBox "In Tabelle3 ist keine Zeile mehr frei"
Application.CutCopyMode = False ' Zwischenspeicher löschen
Exit Sub
End If
.Rows(Loletzte3).PasteSpecial Paste:=xlValues ' Werte übertragen
.Rows(Loletzte3).PasteSpecial Paste:=xlFormats ' Formate übertragen
End With
Exit For ' innere Schleife verlassen da Datensatz gefunden
End If
End If
Next LoJ
Next LoI
Application.CutCopyMode = False ' Zwischenspeicher löschen
Application.ScreenUpdating = True