Makro anpassen

Sub Verteilen()
Application.ScreenUpdating = False
Dim nNumber As Integer, actSh As Worksheet
Dim bComplete As Boolean
bComplete = False
Dim i As Long, nStart, nEnd As Long
nNumber = 0
For i = 3 To 65536
If Sheets(1).Cells(i, 1).Value = "" Then
nEnd = i - 1
Exit For
End If
If nNumber <> Sheets(1).Cells(i, 1).Value Then
If Not bComplete Then
' neues sheet anlegen
nNumber = Sheets(1).Cells(i, 1).Value
nStart = i
Set actSh = Sheets.Add(after:=Worksheets(Worksheets.Count))
' sheet benennen
ActiveSheet.Name = Trim(Str(nNumber))
Sheets(1).Range("a1:t2").Copy
ActiveSheet.Range("a1").Select
' überschrift kopieren
ActiveSheet.Paste
bComplete = True
Else
nEnd = i - 1
' das ende eines blockes wurde erreicht
End If
End If
' das trifft nur dann zu, wenn
' obige if bcomplete schleife einmal komplett durch laufen wurd
If nEnd > nStart Then
' block kopieren
Sheets(1).Range("A" + Trim(Str(nStart)) + ":T" + Trim(Str(nEnd))).Copy
ActiveSheet.Range("a3").Select
ActiveSheet.Paste
nEnd = 0
nStart = 0
bComplete = False
i = i - 1       'wir sind quasi über das ziel hinausgeschossen
End If
Next i
If nEnd > nStart Then
' block kopieren
Sheets(1).Range("A" + Trim(Str(nStart)) + ":T" + Trim(Str(nEnd))).Copy
ActiveSheet.Range("a3").Select
ActiveSheet.Paste
nEnd = 0
nStart = 0
bComplete = False
i = i - 1       'wir sind quasi über das ziel hinausgeschossen
End If
Application.ScreenUpdating = True
End Sub