Sub DatenEinfügen()

    Dim ws As Worksheet ' Variable zur Speicherung des aktuellen Arbeitsblatts
    Dim newSheet As Worksheet ' Variable zur Speicherung des neu erstellten Arbeitsblatts
    Dim lastSheet As Integer ' Index des letzten Arbeitsblatts
    Dim i As Integer ' Zählvariable für die Schleife
    Dim newRow As Integer ' Neue Zeile für das Einfügen der Daten
    Dim counter As Integer ' Zähler für die Anzahl der Schleifendurchläufe
    Dim startRow As Integer ' Startzeile für das Einfügen der Daten

    ' Neues Arbeitsblatt am Ende der Arbeitsmappe einfügen
    Set newSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))

    ' Index des letzten Arbeitsblatts bestimmen
    lastSheet = ThisWorkbook.Sheets.Count - 1

    ' Durchlaufen der Arbeitsblätter ab dem dritten bis zum vorletzten Arbeitsblatt
    For i = 3 To lastSheet
        Set ws = ThisWorkbook.Sheets(i)

        ' Neue Zeile für das Einfügen der Daten bestimmen
        newRow = i - 2

        ' Wert aus Zelle A2 des aktuellen Arbeitsblatts in das neu erstellte Arbeitsblatt kopieren
        newSheet.Cells(newRow, 2).Value = ws.Range("A2").Value

        ' Wert aus Zelle B2 des aktuellen Arbeitsblatts in das neu erstellte Arbeitsblatt kopieren
        newSheet.Cells(newRow, 3).Value = ws.Range("B2").Value

        ' Wert aus Zelle B3 des aktuellen Arbeitsblatts in das neu erstellte Arbeitsblatt kopieren
        newSheet.Cells(newRow, 10).Value = ws.Range("B3").Value

        ' Wert aus Zelle B4 des aktuellen Arbeitsblatts in das neu erstellte Arbeitsblatt kopieren
        newSheet.Cells(newRow, 17).Value = ws.Range("B4").Value

        ' Wert aus Zelle F1 des aktuellen Arbeitsblatts abfragen
        counter = ws.Range("F1").Value

        ' Startzeile für das Einfügen der Daten in der letzten Spalte
        startRow = counter

        ' Schleife für das Einfügen der Daten in die letzte Spalte
        For j = 1 To counter
            ' Wert aus der entsprechenden Zeile der letzten Spalte des aktuellen Arbeitsblatts kopieren
            newSheet.Cells(newRow, j + 9).Value = ws.Cells(startRow, 2).Value
            ' Wenn es nicht die letzte Zeile ist, dann ein Komma anhängen
            If j < counter Then
                newSheet.Cells(newRow, j + 9).Value = newSheet.Cells(newRow, j + 9).Value & ","
            End If
            ' Startzeile um 1 verringern
            startRow = startRow - 1
        Next j

    Next i

End Sub