Tabellen zusammenfügen

Guten Tag Zusammen!
Ich probiere gerade aus einem Haufen Daten wichtige Daten zu selektieren und in einem Datenblatt zusammen zu fassen.
So möchte ich gerne aus unterschiedlichen Tabellenblätter, Spalten kopieren und diese in ein finales Tabellenblatt einfügen. Alle Tab.blätter befinden sich in einer Datei.
Dabei sind die zu kopierenden Spalten in den verschiedenen Tabellenblättern unterschiedlich
aus Tab 1 die Spalten (C, E, P, Q, R)
aus Tab 2 die Spalten (C, D, F, H,I)
Die erste Zeile der jeweiligen Tab.blätter ist die Überschrift. Die 5 zu kopierenden Spalten haben alle die gleiche Überschrift, sind allerdings teils anders im Tabblatt angeordnet. So heißt Spalte c in beiden Fällen 'week', jedoch ist Spalte E in Tab 1 'About' wobei diese in Tabblatt 2 in Spalte D zu finden ist.
Diese 5 Spalten sollen also jetzt in das Tabellenblatt 'Final' kopiert werden. Die erste Zeile in diesem Tab 'Final' soll die Überschriften der 5 kopierten Spalten besitzen.
Es soll immer in die erste freie Zeile im Tab kopiert werden. Überschriften aus der 1. Zeile sollen nicht mit kopiert werden. Idee ist, dass ich von allen Tabblättern die Daten zusammentragen kann ohne dass jeweils geschriebene Daten wieder gelöscht werdne.
Ist dieses mit einem Makro möglich ?
An anderer Stelle habe ich mit einer Suchfunktion gearbeitet:
Set Treffer = .Rows(1).Find(what:="Date", lookat:=xlWhole)
If Treffer Is Nothing Then
Worksheets("data_illness").Cells(1, Worksheets("data_illness"). _
Columns.Count).End(xlToLeft).Offset(0, 1) = "Date"
Else
.Columns(Treffer.Column).Copy
Worksheets("data_illness").Cells(1, Worksheets("data_illness"). _
Columns.Count).End(xlToLeft).Offset(0, 1). _
PasteSpecial Paste:=xlPasteAll
End If
... allerdings weiß ich nicht wie ich dieses auf verschiedene Tabblätter bekomme, ohne dass einmal in Finale Tabblatt überschriebene Daten wieder gelöscht werden.
Gerne höre ich Vorschläge wie ich dieses Umsetzen kann.
Merci!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo icks1,
wenn m Blatt "Final" in Zeile1 die SPalten-Titel der aus den anderen Blättern zu kopierenden Spalten eingetragen sind, dann funktioniert es mit folgendem Makro.
Die Nummern des Spaltenbereichs in der For-Zeile mit den Spalten-Titeln musst du ggf. anpassen.
LG
Franz

Sub Copy_to_Final()
If MsgBox("Daten ins Blatt ""Final"" kopieren?", vbQuestion + vbOKCancel, _
"Daten konsolidieren") = vbCancel Then Exit Sub
Dim wksFinal As Worksheet
Dim Spa_F As Long, Zei_F As Long, Spa_Titel As String, rngZelle As Range
Dim wksData As Worksheet
Dim Spa_D As Long, Zei_D As Long
Set wksFinal = ActiveWorkbook.Worksheets("Final")
With wksFinal
'letzte Zeile mit Inhalt in Blatt Final
Zei_F = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlPart, searchdirection:=xlPrevious).Row
'nächste freie Zeile
Zei_F = Zei_F + 1
End With
Application.ScreenUpdating = False
'Tabellenblätter in Arbeitsmappe abarbeiten
For Each wksData In ActiveWorkbook.Worksheets
Select Case wksData.Name
Case wksFinal.Name
'Daten dieser Blätter nicht kopieren
Case Else
With wksData
'letzte Zeile mit Inhalt in Blatt
Set rngZelle = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlPart, searchdirection:=xlPrevious)
If Not rngZelle Is Nothing Then
Zei_D = rngZelle.Row
If Zei_D > 1 Then
'Spalten mit Spaltentiteln in Blatt "Final" abarbeiten
For Spa_F = 1 To 5
'Spaltentitel merken
Spa_Titel = wksFinal.Cells(1, Spa_F).Value
'Spalte mit Spaltentitel in Blatt in Zeile 1 suchen
Set rngZelle = .Rows(1).Find(What:=Spa_Titel, LookIn:=xlValues, _
lookat:=xlWhole)
If Not rngZelle Is Nothing Then
Spa_D = rngZelle.Column
'Daten nach "Final" kopieren
.Range(.Cells(2, Spa_D), .Cells(Zei_D, Spa_D)).Copy _
Destination:=wksFinal.Cells(Zei_F, Spa_F)
End If
Next Spa_F
'nächste Einfügezeile in Final setzen
Zei_F = Zei_F + Zei_D - 1
End If
End If
End With
End Select
Next
Application.ScreenUpdating = True
End Sub

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread