Option Explicit
Public Sub TabelleAutoFuellen()
Dim iUserAngabe%
Dim i%, y%
Dim flag As Boolean

'UserAngabe steht in Zelle A1
iUserAngabe = Sheets(1).Cells(1, 1).Value

For i = 1 To iUserAngabe
        'Solange Angabe <10 -> Blatt1
        If i < 10 Then
            y = 1
            'Blatt1, Zellen B1-J1 befüllen
            Sheets(y).Cells(1, i + 1).Value = "B 0" & i & "/08"
            'letzer Eintrag auf Blatt, boolean-Variable auf false setzen
            If i = 9 Then flag = False
            Else
                'Wenn zw. 10 und 18 -> 2. Blatt
                If i > 9 And i < 19 Then
                    '2. Blatt, erst das erste kopieren, dann die Zellen richtig befüllen
                    y = 2
                    'Wenn Blatt noch nicht vorhanden, Vorblatt kopieren, Zellen B1-J1 löschen
                    If flag = False Then
                        Sheets(y - 1).Copy after:=Sheets(y - 1)
                        Sheets(y).Range(Cells(1, 1), Cells(1, 10)).ClearContents
                        flag = True 'flag auf true setzen = Blatt erfolgreich kopiert
                    End If
                    'wenn Blatt vorhanden->Inhalte in B1-J1 einfügen
                    If flag = True Then
                        Sheets(y).Cells(1, i - 8).Value = "B " & i & "/08"
                    End If
                Else
                'letzer Eintrag auf Blatt, boolean-Variable auf false setzen
                If i = 19 Then flag = False
                'Kommentare s. Blatt 2
                If i > 18 And i < 28 Then
                    y = 3
                    If flag = False Then
                        Sheets(y - 1).Copy after:=Sheets(y - 1)
                        Sheets(y).Range(Cells(1, 1), Cells(1, 10)).ClearContents
                        flag = True
                    End If
                    If flag = True Then
                        Sheets(y).Cells(1, i - 17).Value = "B " & i & "/08"
                    End If
                Else:
                MsgBox "Makro läuft nur bis Datensatz 27" & Chr(10) & "für weitere Datensätze, bitte Makro erweitern"
                Exit For
                End If
            End If
        End If
Next i
End Sub