Zeilen in Excel einfügen wenn eine Bedingung erfüllt ist

Sub InsertRowsAfterDuplicates()
    Dim ws As Worksheet, rngCurrent As Range, cnt as integer, lastValue as String
    Set ws = Sheets(1)
    Set rngCurrent = ws.Range("Z1")  
    lastValue = ""  
    cnt = 0
    While rngCurrent.Value <> ""  
        If lastValue = rngCurrent.Value Then
            cnt = cnt + 1
            lastValue = rngCurrent.Value
            Set rngCurrent = rngCurrent.Offset(1, 0)
        Else
            If cnt >= 2 Then
                rngCurrent.EntireRow.Insert
                rngCurrent.EntireRow.Insert
                lastValue = rngCurrent.Value
                Set rngCurrent = rngCurrent.Offset(1, 0)
            Else
                lastValue = rngCurrent.Value    
            End If
            cnt = 0
        End If
    Wend
End Sub

Sub Test()
    Dim oFound As Range, i As Long
    
    With Sheets("Tabelle1")  
        For i = .UsedRange.Rows.Count To 1 Step -1
            If .Cells(i, "Z").Text <> "" Then  
                Set oFound = .Columns("Z:Z").Find(.Cells(i, "Z").Text, .Cells(i, "Z"), xlValues, xlWhole)  
                
                If Not oFound Is Nothing Then
                    If oFound.Row < i Then
                        .Rows(i + 1).Insert Shift:=xlDown:  i = oFound.Row
                    End If
                End If
            End If
        Next
    End With
End Sub