Dim TargetSh As Worksheet
Dim SourceSh As Worksheet
Sub ProcessCurrentSheet()
Dim RowIndex As Long
Const ColNum_PartNumber =  10 
Const ColNum_SparePartDesignation =  3 
Dim OwnerName As String
Dim PartNumberString As String
Dim SparePartDesignationString As String

    With TargetSh
        .Range("A1").FormulaR1C1 = "Besitzer"
        .Range("B1").FormulaR1C1 = "Bezeichnung der benotigten Ersatzteile"
        .Range("C1").FormulaR1C1 = "E-Nr."
        .Columns("A:C").EntireColumn.AutoFit
    End With
    
    OwnerName = SourceSh.Range("G7").Value
    
    RowIndex =  27 
    Do While SourceSh.Cells(RowIndex, ColNum_PartNumber).Value <> ""
        PartNumberString = SourceSh.Cells(RowIndex, ColNum_PartNumber).Value
        SparePartDesignationString = SourceSh.Cells(RowIndex, ColNum_SparePartDesignation).Value
        
        LastTargetRow = TargetSh.Cells.SpecialCells(xlCellTypeLastCell).Row
        TargetSh.Cells(LastTargetRow +  1 ,  1 ).Value = OwnerName
        TargetSh.Cells(LastTargetRow +  1 ,  2 ).Value = SparePartDesignationString
        TargetSh.Cells(LastTargetRow +  1 ,  3 ).Value = PartNumberString
        
        RowIndex = RowIndex +  1 
    Loop
End Sub
Sub main()
Dim SourceWB As Workbook

    Set SourceWB = ActiveWorkbook
    Set TargetSh = Workbooks.Add.Sheets( 1 )

    SourceWB.Activate
    
    For Each SourceSh In ActiveWorkbook.Sheets
        ProcessCurrentSheet
    Next SourceSh
    
    Set TargetWB = Nothing
    Set SourceWB = Nothing

End Sub