Excel Tabellen zusammenfügen
 

Hallo Leute,

Ich brauch wirklich Hilfe sonst wird das nichts.

Ich habe eine Excel Datei mit 12 Tabellen und möchte jetzt 10 Tabellen davon in einer Tabelle zusammenfassen.

.) Alle 10 Tabellen haben die gleichen Spaltenüberschriften (9 Spalten).
.) in den Daten kommen manchmal auch Leerzeilen vor (das könnte ich auch händisch ändern lieber wäre mir aber nicht )

Bei meiner Suche habe ich den Code gefunden war aber leider nicht in der Lage in so umzuschreiben das er macht was ich will.

Danke schon jetzt für eure Hilfe.

Michael



Sub kopieren()

Dim rngQ As Range, rngZ As Range

For Each rngQ In Workbooks("Mappe2.xls").Sheets(1).Range("A2:A" & _
Workbooks("Mappe2.xls").Sheets(1).Range("A65536"). End(xlUp).Row)

Set rngZ = Workbooks("Mappe1.xls").Sheets(1).Range("A:A").Fin d(What:=rngQ, Lookat:=xlWhole)
If rngZ Is Nothing Then
Range(rngQ, rngQ.End(xlToRight)).Copy Destination:=Workbooks("Mappe1.xls").Sheets(1) _
.Range("A2").End(xlDown).Offset(1, 0)
Else
Range(rngQ.Offset(0, 1), rngQ.End(xlToRight)).Copy _
Destination:=rngZ.End(xlToRight).Offset(0, 1)
End If

Next rngQ

Ich habe doch eine Variante gefunden die ich anpassen konnte.

Sub Zusammenfassen()
Application.Volatile
Dim intI%, lngZ&, lngZA&, lngGesamt&
'Falls Blatt "Zusammenfassung" existiert, löschen:
On Error GoTo weiter
Application.DisplayAlerts = False
Sheets("Zusammenfassung").Delete
Application.DisplayAlerts = True
weiter:
'Neues Blatt erstellen:
Sheets.Add before:=Sheets(1)
ActiveSheet.Name = "Zusammenfassung"
[a2].Select
'Spaltenüberschriften aus zweitem Blatt eintragen:
Sheets(2).[a1:i1].Copy Destination:=Sheets(1).[a1]
'Überprüfen, ob es insgasamt über 65535 Datensätze sind:
For intI = 2 To Sheets.Count
With Sheets(intI)
lngZA = .Cells(Rows.Count, 1).End(xlUp).Row
lngGesamt = lngGesamt + lngZA - 1
If lngGesamt > 65535 Then
MsgBox "Zuviele Datensätze!", vbOKOnly + vbExclamation, "Fehler!"
Exit Sub
End If
End With
Next
'Einzelne Blätter auf Blatt "Zusammenfassung" zusammenfassen:
lngZ = 2
'von Blatt bis Blatt das zusammengefasst werden soll:
For intI = 2 To 10
With Sheets(intI)
lngZA = .Cells(Rows.Count, 1).End(xlUp).Row
.Range(.Cells(2, 1), .Cells(lngZA, 9)).Copy Destination:=Sheets(1).Cells(lngZ, 1)
lngZ = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1
End With
Next
lngZ = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1

End Sub

du möchtest doch bitte den Code Tag verwenden

pong

Hallo spöppi,
hier ein Tip aus einem Excel-Newsletter, vielleicht hilft´s Dir weiter:

DOWNLOAD-TIPP: Tabellen aus mehreren Arbeitsmappen
ganz einfach zusammenfassen
--------------------------------------------------
Versionen: Excel 2003, 2002/XP und 2000

Das Zusammenfuehren von Tabellen aus mehreren Arbeitsmappen
ist allein mit KOPIEREN und EINFUEGEN ein muehsames
Unterfangen. Mit dem SmartTools MapMerger gelingt die
Kombination von Tabellen voll automatisch: Per Assistent
waehlen Sie zunaechst die zusammenzufuehrenden Dateien sowie
eine Ziel-Arbeitsmappe aus und klicken auf ZUSAMMENFASSEN.
Nacheinander wird dann Mappe fuer Mappe geoeffnet, wobei Sie
per Mausklick bestimmen, welche Tabelle jeweils uebernommen
wird und welche nicht.

So erhalten Sie im Handumdrehen Zusammenfassungen Ihrer
Kalkulationen, Budgetplaene und Projekte und muessen sich
nicht manuell durch verschiedene Dateien arbeiten.

Sie finden den kostenlosen Download unter:

http://www.add-in-world.com/katalog/excel-mapmerger/