Zusammenfassung 2 Tab mit Makro
24.08.2020 15:33:35
Andreas
um einem Kollegen die Arbeit etwas zu erleichtern habe ich begonnen ein kleines Makro zu schreiben. Leider stoße ich hiermit an meine VBA-Grenzen und innerhalb meiner Abteilung kennt sich keiner so richtig mit VBA aus...
Aus zwei Excellisten sollen Arbeitsblätter in eine dritte kopiert (Zusammenfassung) werden. Aus den beiden Blättern soll dann noch ein drittes Blatt mit bestimmten Informationen aus den beiden eingefügten Blättern entstehen.
Mit dem Makro "AlleSheetsAusAllenGewaehltenMappenInEineMappeZusammenfuegen()" klappt das schon recht gut. Allerdings möchte ich von beiden Listen nur das jeweils erste Tablettenblatt einfügen. Aktuell fügt es alle vorhanden ein. Außerdem sollen die Arbeitsblätter am Ende stehen. Aktuell werden sie zwischen dem ersten und zweiten Blatt eingefügt (zwei Blätter in Zusammenfassungsliste schon vor dem Zusammenfügen vorhanden).
Das zweite Makro "Tabelle_zusammenfassen()" soll aus den beiden Tabellenblättern bestimmte Spalten rauskopieren und in ein neues Tabellenblatt einfügen. Ich bin schon so weit gekommen, dass die Listen in ein neues Blatt "Zusammenfassung" untereinander kopiert werden. Der Wunsch wäre, dass aus Blatt 1 nur zwei Spalten kopiert werden (z.B. Spalte D und J) und aus Blatt 2 eine Spalte (z.B. B). Die Spalten nicht untereinander angeordnet sondern nebeneinander (beginnend mit Spalte B, Zeile 2). Das Ergebnis möchte ich dann mit SVERWEIS vergleichen (dritter Schritt).
Für eine Hilfe wäre ich sehr dankbar! Bin noch ein absoluter VBA-Neuling :)
Vielen Dank im Voraus!
Andreas
Sub AlleSheetsAusAllenGewaehltenMappenInEineMappeZusammenfuegen()
Dim vntPathAndFileNames As Variant
Dim strPathAndFile As String
Dim lngI As Long
Dim wbkMappe As Workbook
Dim wksT As Worksheet
Dim wbkZiel As Workbook
Set wbkZiel = ThisWorkbook
vntPathAndFileNames = Application.GetOpenFilename( _
FileFilter:="Excel Files (*.xlsx), *.xlsx", _
Title:="Dateien mit gedrückter Strg Taste markieren!", _
MultiSelect:=True)
If VarType(vntPathAndFileNames) = vbBoolean Then
MsgBox "Abgebrochen!"
Else
For lngI = LBound(vntPathAndFileNames) To UBound(vntPathAndFileNames)
strPathAndFile = vntPathAndFileNames(lngI)
Set wbkMappe = Application.Workbooks.Open(strPathAndFile)
For Each wksT In wbkMappe.Worksheets
wksT.Copy wbkZiel.Worksheets(wbkZiel.Worksheets.Count)
Next
wbkMappe.Close False
Next
End If
Sub Tabelle_zusammenfassen()
Dim i As Integer
Dim Zusammenfassung As Worksheet
Set Zusammenfassung = Worksheets("Zusammenfassung")
For i = 2 To Worksheets.Count
Set BereichZielTab = Worksheets(i).UsedRange
Set LetzteZeileZusammenfassung = Worksheets(1).Cells(Rows.Count, "A").End(xlUp)(2)
BereichZielTab.Copy Destination:=LetzteZeileZusammenfassung
Next i
End Sub