Sub DatenKopieren()

    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

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

    ' Reihe 141 aus Arbeitsblatt 1 in das neu erstellte Arbeitsblatt kopieren
    ThisWorkbook.Sheets(1).Rows(141).Copy Destination:=newSheet.Range("A1")

    ' 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 - 1

        ' 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
    Next i

End Sub