Excel Makro Hilfe - Makro zum Zusammenfassen von Zeilen mehrerer Dateien

Hallo bastla,

ich bin recht neue Hier und hoffe sehr auf ihre Unterstützung.
ich bekomme jeden tag eine Datei mit mehrere Excel Tabellen
ich muss aus dem Dateien nur einen bestimmten Datenblatt auswerten.
so sehen sie ungefähr.
Block Weight [kg] X Y Z Material Density
SA2101 334514 1 2 3 A 8000kg/m3
SA2101 044514 1 2 3 A 8000kg/m3
SA3101 334514 1 2 3 A 8000kg/m3
SA3101 334514 1 2 3 A 8000kg/m3
SA2101 334514 1 2 3 A 8000kg/m3
SA5101 334514 1 2 3 A 8000kg/m3
SA5101 334514 1 2 3 A 8000kg/m3
als Beispiel

ich möchte alle typen aussuchen und summieren in gruppen in eine anderen Tabelle
und automisch neue typen erkennen und ausführen.

folgendes habe ich geschrieben aber er speichert die Daten nicht in die neue Tabelle.

Application.ScreenUpdating = False
' turns off screen updating
Application.DisplayStatusBar = True
' makes sure that the statusbar is visible
' Application.Wait Now + TimeValue("00:00:02")


'---------------------------------------------------
'Initialisierung der Variablen
'---------------------------------------------------

Dim oMe As Object, sSuchbegriff()
Dim oFS As Object
Dim oDatei As Object

Dim actRow As Long
Dim actGroup As String
Dim sBereich As String
Dim sKennz As String
Dim sWbName As String
Dim bEintrag As Boolean
Dim wsTabelle As Worksheet


Dim rFound As Range
Dim vWert As Variant


Dim actGroupNumber As Integer 'Zeile, in der die erste Zusammenfassung geschrieben wird
Dim iSbMax As Integer
Dim iLK As Integer
Dim i As Integer
Dim iZeile As Integer

Dim totalWeight As Double 'Totales Gewicht; Summation der einzelnen Posten
Dim totalGroupWeight As Double 'Totales aktuelles Gruppengewicht
Dim totaladdedGroupWeight As Double 'Totales Gewicht, Summation der einzelnen Gruppen
'---------------------------------------------------
'Setzen der Variablen
'---------------------------------------------------

Set oMe = ThisWorkbook.Worksheets("Auswertung") 'Zieltabelle (in der gerade geöffneten Datei)
'iZeile = 2 'ab dieser Zeile Ergebnisse in die Zieltabelle eintragen
actRow = 5 'Zeile, in der die Iteration beginnt
actGroupNumber = 5

totalWeight = 0
totalGroupWeight = 0
totaladdedGroupWeight = 0

Const sDateiPfad As String = "C:\Users\wis-ikk\Desktop\2016_11_04" 'Pfad für zu durchsuchende Excel-Dateien; mit Backslash am Ende
sKennz = "HULL WCOG" 'Nur Tabellen, deren Name mit dem Kennzeichen beginnt, verarbeiten

iLK = Len(sKennz) 'Länge des Tabellennamen-Kennzeichens
Set oFS = CreateObject("Scripting.FileSystemObject")
For Each oDatei In oFS.GetFolder(sDateiPfad).Files
sWbName = oDatei.Name
Workbooks.Open (oDatei.Path)
For Each wsTabelle In Workbooks(sWbName).Worksheets()
If StrComp(Left(wsTabelle.Name, iLK), sKennz, vbTextCompare) = 0 Then

bEintrag = False
For i = 0 To iSbMax

actGroup = Worksheets("HULL WCOG").Cells(actRow, 2)


Do While Not Worksheets("HULL WCOG").Cells(actRow, 1) = ""

Application.StatusBar = "Processing Group " & actGroup & " | Processed Items: " & actRow

If (actGroup <> Worksheets("HULL WCOG").Cells(actRow, 2)) Then

'Group Values speichern
Worksheets("HULL WCOG").Cells(actGroupNumber, 14) = actGroup
Worksheets("HULL WCOG").Cells(actGroupNumber, 15) = totalGroupWeight

'neuen Gruppennamen definieren
actGroup = Worksheets("HULL WCOG").Cells(actRow, 2)
actGroupNumber = actGroupNumber + 1

totaladdedGroupWeight = totaladdedGroupWeight + totalGroupWeight

totalGroupWeight = Worksheets("HULL WCOG").Cells(actRow, 5)


Else
Dim tempGroupfromPartName As String
tempGroupfromPartName = Left(Worksheets("HULL WCOG").Cells(actRow, 3), 6)


If Not (tempGroupfromPartName = actGroup) Then
Dim Mldg, Stil, Titel, Antwort
Mldg = "BLOCK MODULE NAME " & actGroup & " mit PART NAME " & tempGroupfromPartName & " nicht konsistent! Fortfahren?" ' Meldung definieren.
Stil = vbYesNo + vbCritical + vbDefaultButton2 ' Schaltflächen definieren.
Titel = "MsgBox-Demonstration" ' Titel definieren.

Antwort = MsgBox(Mldg, Stil, Titel) ' Meldung anzeigen.

If Antwort = vbYes Then ' Benutzer hat "Ja" gewählt.

Else ' Benutzer hat "Nein" gewählt.
Exit Sub
End If


End If

totalGroupWeight = totalGroupWeight + Worksheets("HULL WCOG").Cells(actRow, 5)

End If


totalWeight = totalWeight + Worksheets("HULL WCOG").Cells(actRow, 5)

actRow = actRow + 1

Loop


totaladdedGroupWeight = totaladdedGroupWeight + totalGroupWeight

Worksheets("HULL WCOG").Cells(actGroupNumber, 14) = actGroup
Worksheets("HULL WCOG").Cells(actGroupNumber, 15) = totalGroupWeight


Worksheets("HULL WCOG").Cells(actGroupNumber + 2, 14) = "Total Weight"
Worksheets("HULL WCOG").Cells(actGroupNumber + 2, 15) = totalWeight
Worksheets("HULL WCOG").Cells(actGroupNumber + 3, 14) = "Total Added Group Weight"
Worksheets("HULL WCOG").Cells(actGroupNumber + 3, 15) = totaladdedGroupWeight

Next
If bEintrag Then iZeile = iZeile + 1 'mindestens ein Eintrag erfolgt, daher neue Zeile
End If


Next
Workbooks(sWbName).Saved = True

Workbooks(sWbName).Close

Next
Application.ScreenUpdating = True
' gives control of the statusbar back to the programme

End Sub


was mache ich den falsch ????

Leute bitte Hiiiilfeeeeeeeee!!!!!!!!!!!!!!!!!!!!!!!!