Makro: Einzelblätter zusammenführen

Hallo Zusammen,
ich stehe vor einem Problem, das ich leider nicht selbst lösen kann.
Daher bitte ich um eure Hilfe.
Ich habe in einer Datei 3 Blätter:
- Datei1_Bericht
- Datei2_Bericht
- Datei3_Bericht
Die Inhalte dieser 3 "Berichte" sollen nun in einen Gesamtbericht zusammengefügt werden im Blatt "Bericht". Das Problem ist, das "Werte" in den Blättern doppelt vorkommen können. Diese sollen dann im Gesamtbericht addiert werden.
In diesem Blatt stehen jedoch schon Formeln, die nicht verändert werden sollen beim späteren Einfügen der Inhalte aus den 3 anderen Blättern.
Daher sollen am Anfang nur die Inhalte der Zellen A12- Ende, C12- Ende, G12- Ende und H12-Ende gelöscht werden.
Anschließend sollen in der Reihenfolge Datei1_Bericht, Datei2_Bericht und Datei3_Bericht die Inhalte der Zeilen 12 bis zur jeweils letzten gefüllten Zelle in Spalte A in diesen Gesamtbericht reinkopiert werden. Kopiert werden sollen aber jeweils von den Zeilen nur die Werte aus A,C,G und H. Zielzellen sind auch A,C,G, und H in "Bericht".
Die Zeilen sollen dort jeweils nach unten angehängt werden.
Anschließend sollen noch unter bestimmten Bedingungen Werte addiert werden.
Aber ich denke das kann man nach dem ganzen Kopierkram immer noch machen.
Ich hoffe mir kann einer helfen,
Daniel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Daniel,
ich bin auch fertig!


Sub Zusammenfassen()
Const EZ = 12
Dim LZ As Long, i As Long
Dim sh As Worksheet, sh_Z As Worksheet
Set sh = Sheets("Bericht")
Application.ScreenUpdating = False
With sh
sh.Range(.Cells(EZ, 1), .Cells(.Rows.Count, 1)).ClearContents
sh.Range(.Cells(EZ, 3), .Cells(.Rows.Count, 3)).ClearContents
sh.Range(.Cells(EZ, 7), .Cells(.Rows.Count, 7)).ClearContents
sh.Range(.Cells(EZ, 8), .Cells(.Rows.Count, 8)).ClearContents
End With
For Each sh_Z In Worksheets
If sh_Z.Name Like "*_Bericht" Then
With sh_Z
LZ = .Cells(Rows.Count, 1).End(xlUp).Row
For i = EZ To LZ
AddEintrag .Cells(i, 1), .Cells(i, 3), .Cells(i, 7), .Cells(i, 8)
Next i
End With
End If
Next sh_Z
Application.ScreenUpdating = True
End Sub
Sub AddEintrag(ByVal s1, ByVal s3, ByVal s7, ByVal s8)
Const EZ = 12
Dim LZ As Long
Dim ze As Double
Dim sh As Worksheet
Dim Werte As Range
Set sh = Sheets("Bericht")
With sh
Set Werte = .Range(.Cells(EZ, 1), .Cells(.Rows.Count, 1))
On Error Resume Next
ze = WorksheetFunction.Match(s1, Werte, 0)
If Err.Number > 0 Then
'Err.Clear
ze = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
If ze < EZ Then ze = EZ
.Cells(ze, 1) = s1
Else
ze = EZ + ze - 1
End If
On Error GoTo 0
If s3 = "" Then s3 = 0
If s7 = "" Then s7 = 0
If s8 = "" Then s8 = 0
.Cells(ze, 3) = .Cells(ze, 3) + s3
.Cells(ze, 7) = .Cells(ze, 7) + s7
.Cells(ze, 8) = .Cells(ze, 8) + s8
End With
End Sub

Gruß Matthias

Sub AddEintrag(ByVal s1, ByVal s3, ByVal s7, ByVal s8) Const EZ = 14 Dim LZ As Long Dim ze As Double Dim sh As Worksheet Dim Werte As Range Set sh = Sheets("Bericht") With sh Select Case LCase(s1) Case "gxa" ze = 12 .Cells(ze, 1) = s1 Case "vga" ze = 13 .Cells(ze, 1) = s1 Case Else Set Werte = .Range(.Cells(EZ, 1), .Cells(.Rows.Count, 1)) On Error Resume Next ze = WorksheetFunction.Match(s1, Werte, 0) If Err.Number > 0 Then 'Err.Clear ze = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 If ze < EZ Then ze = EZ .Cells(ze, 1) = s1 Else ze = EZ + ze - 1 End If End Select On Error GoTo 0 If s3 = "" Then s3 = 0 If s7 = "" Then s7 = 0 If s8 = "" Then s8 = 0 .Cells(ze, 3) = .Cells(ze, 3) + s3 .Cells(ze, 7) = .Cells(ze, 7) + s7 .Cells(ze, 8) = .Cells(ze, 8) + s8 End With End Sub

Beliebteste Forumthreads (12 Monate)

Makro: Einzelblätter zusammenführen

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro: Einzelblätter zusammenführen

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread