Makro steigt in letzter Zeile aus

Hallo Excel-Tüftler,
ich habe ein Makro das 3 Wörterbücher vergleicht und ggf. Zeilen einfügt bzw. Werte verschiebt.
Es funktioniert - aber in der letzten Zeile tut er es nicht mehr - ich verstehe nicht warum.
Anbei der Code (Mappe hängt auch anbei):

Sub spaten2schiebenxx()
Dim CompResult1 As Integer
Dim CompResult2 As Integer
Dim CompResult3 As Integer
Dim CompResult4 As Integer
Dim CompResult5 As Integer
Dim CompResult6 As Integer
Dim maxR As Long, r As Long
'Sortiere
Columns("A:D").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, Key2:=Range("C2") _
, _
Order2:=xlAscending, Header:=xlYes
Columns("C:D").Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlYes
Columns("E:F").Sort Key1:=Range("E2"), Order1:=xlAscending, Header:=xlYes
maxR = Cells(Rows.Count, 1).End(xlUp).Row
r = 2
While r < maxR
'Wert in Spalten?
'If Len(Cells(r, 1)) * Len(Cells(r, 5)) > 0 Then
If Not IsEmpty(Cells(r, 1)) And Not IsEmpty(Cells(r, 3)) And Not IsEmpty(Cells(r, 5)) Then
'Vergleiche Texte
CompResult1 = StrComp(Cells(r, 1), Cells(r, 3), vbTextCompare)
CompResult2 = StrComp(Cells(r, 1), Cells(r, 5), vbTextCompare)
CompResult3 = StrComp(Cells(r, 3), Cells(r, 1), vbTextCompare)
CompResult4 = StrComp(Cells(r, 3), Cells(r, 5), vbTextCompare)
CompResult5 = StrComp(Cells(r, 5), Cells(r, 1), vbTextCompare)
CompResult6 = StrComp(Cells(r, 5), Cells(r, 3), vbTextCompare)
' If CompResult1 <> 0 And CompResult2 <> 0 Then
'Zelleninhalte der Zeile unterscheiden sich,
If CompResult5 = -1 And CompResult6 = -1 Then Range(Cells(r, 1), Cells(r, 2)).Insert shift:= _
xlDown
If CompResult5 = -1 And CompResult6 = -1 Then Range(Cells(r, 3), Cells(r, 4)).Insert shift:= _
xlDown
If CompResult3 = -1 And CompResult4 = -1 Then Range(Cells(r, 1), Cells(r, 2)).Insert shift:= _
xlDown
If CompResult3 = -1 And CompResult4 = -1 Then Range(Cells(r, 5), Cells(r, 6)).Insert shift:= _
xlDown
If CompResult1 = -1 And CompResult2 = -1 Then Range(Cells(r, 3), Cells(r, 4)).Insert shift:= _
xlDown
If CompResult1 = -1 And CompResult2 = -1 Then Range(Cells(r, 5), Cells(r, 6)).Insert shift:= _
xlDown
If CompResult1 = 0 And CompResult2 = -1 And CompResult4 = -1 Then Range(Cells(r, 5), Cells(r, 6) _
).Insert shift:=xlDown
If CompResult2 = 0 And CompResult3 = 1 And CompResult4 = 1 Then Range(Cells(r, 3), Cells(r, 4)). _
Insert shift:=xlDown
If CompResult4 = 0 And CompResult3 = -1 And CompResult5 = -1 Then Range(Cells(r, 1), Cells(r, 2) _
).Insert shift:=xlDown
If CompResult3 = 1 And CompResult4 = -1 Then Range(Cells(r, 5), Cells(r, 6)).Insert shift:= _
xlDown
'If CompResult1 = 1 And CompResult2 = 1 Then Range(Cells(r, 1), Cells(r, 2)).Insert  _
shift:=xlDown
'If CompResult3 = 1 And CompResult4 = 1 Then Range(Cells(r, 3), Cells(r, 4)).Insert  _
shift:=xlDown
'If CompResult5 = 1 And CompResult6 = 1 And CompResult3 = 1 And CompResult4 = -1 And  _
CompResult2 = -1 And CompResult1 = -1 Then Range(Cells(r, 5), Cells(r, 6)).Insert shift:=xlDown
'If IsEmpty(Cells(r, 1)) And IsEmpty(Cells(r + 1, 1)) And CompResult6 = 1 And  _
CompResult4 = -1 Then Range(Cells(r, 3), Cells(r, 4)).Insert shift:=xlDown
'FALSCH If CompResult3 = -1 Then Range(Cells(r, 1), Cells(r, 2)).Insert shift:=xlDown
If r < maxR Then maxR = maxR + 1
End If
'End If
r = r + 1
Wend
End Sub

https://www.herber.de/bbs/user/43658.xls
Wer weiß Rat??
Vielen dank
lobby007