VBA - Zellen aus versch. Blätter

Hallo Zusammen
Ich würde gerne ein Makro schreiben, welches mir bestimmte Zellen aus einer beliebigen Anzahl Arbeitsblätter kopiert und diese dann in einem "Master-Arbeitsblatt" einfügt.
Zur Veranschaulichung:
1. For Each ws In ActiveWorkbook.Worksheets
If ws.Name "Master-Arbeitsblatt" Then.....
2. Kopiere Zellen A1, B4, C3:C8 vom ersten Arbeitsblatt
3. Füge Zelle A1 in Spalte B vom "Master-Arbeitsblatt" ein, Zelle B4 in Spalte C, Zellen C3:C8 in Spalte D vom "Master-Arbeitsblatt".
4. Suche die nächste komplett freie Zeile im "Master-Arbeitsblatt" und füge dort dieselben Zellen (A1. B4, C3:C8) vom zweiten Arbeitsblatt ein
5. Führe den Loop so oft durch, bis jedes Arbeitsblatt einmal dran war.
Ich habe mehrere Optionen versucht, bin jedoch nicht auf die Lösung gekommen.
Das ist der Code, welcher ich bis jetzt habe:
----------------------------------------------------------------------------------------------------------------------
Dim MF As Worksheet, SF As Worksheet
Dim TargetRow As Long, Index As Long
Dim SourceArr As Variant, DestArr As Variant
Dim Source As Range, Dest As Range
Dim ws As Worksheet
'set references up-front
Set SF = ThisWorkbook.Worksheets("erstes Arbeitsblatt")
Set MF = ThisWorkbook.Worksheets("Masterfile")
With MF
TargetRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
End With
SourceArr = Array("D1:M1", "D2:M2", "D3:M3", "D4:M4", "D5:M5", "B8:M12", "A16:M23", "B27:M36", "B39:M42")
DestArr = Array("A", "B", "C", "D", "E", "F", "G", "J", "K")
For Index = LBound(SourceArr) To UBound(SourceArr)
Set Source = SF.Range(SourceArr(Index))
Set Dest = MF.Range(DestArr(Index) & TargetRow)
Source.Copy
Dest.PasteSpecial (xlPasteValues)
Next Index
----------------------------------------------------------------------------------------------------------------------
Leider funktioniert dieser Code nur für das "erste Arbeitsblatt" & hat auch keine Funktion, um die nächste komplett freie Zeile zu finden.
Ich bedanke mich herzlich im Voraus.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Reto,
dann teste mal diesen Code:

Public Sub Uebertrag()
Dim obj_wks_ziel As Worksheet
Dim obj_wks_quelle As Worksheet
Dim lng_zeile As Long
Dim lng_max_zeile As Long
Dim lng_letzte_zeile As Long
Set obj_wks_ziel = Worksheets("Masterfile")  ' Hier Zieltabellenblatt benennen
lng_zeile = 2       ' Startzeile im Zielblatt
For Each obj_wks_quelle In ThisWorkbook.Worksheets
With obj_wks_quelle
If .Name  "Masterfile" Then
.Range("D1:D5").Copy
obj_wks_ziel.Cells(lng_zeile, 1).PasteSpecial Transpose:=True
.Range(.Cells(8, 2), .Cells(12, 2)).Copy obj_wks_ziel.Cells(lng_zeile, 6)
lng_max_zeile = obj_wks_ziel.Cells(Rows.Count, 6).End(xlUp).Row
.Range(.Cells(16, 1), .Cells(23, 3)).Copy obj_wks_ziel.Cells(lng_zeile, 7)
lng_letzte_zeile = obj_wks_ziel.Cells(Rows.Count, 7).End(xlUp).Row
If lng_letzte_zeile > lng_max_zeile Then lng_max_zeile = lng_letzte_zeile
.Range(.Cells(27, 2), .Cells(36, 2)).Copy obj_wks_ziel.Cells(lng_zeile, 10)
lng_letzte_zeile = obj_wks_ziel.Cells(Rows.Count, 10).End(xlUp).Row
If lng_letzte_zeile > lng_max_zeile Then lng_max_zeile = lng_letzte_zeile
.Range(.Cells(40, 2), .Cells(42, 2)).Copy obj_wks_ziel.Cells(lng_zeile, 11)
lng_letzte_zeile = obj_wks_ziel.Cells(Rows.Count, 11).End(xlUp).Row
If lng_letzte_zeile > lng_max_zeile Then lng_max_zeile = lng_letzte_zeile
lng_zeile = lng_max_zeile + 1
End If
End With
Next
With obj_wks_ziel
.Range(.Cells(2, 1), .Cells(lng_max_zeile + 10, 11)).ClearFormats
End With
End Sub

Die Ermittlung der jeweils letzten Zeile eines Blocks ist nicht wirklich elegant, was besseres fiel mir aber gerade nicht ein.
Grundsätzlich würde ich das Ganze eher in einer Datenbank (z.B. Access) lösen. Die einzelnen Tabellen sauber mit einander in Beziehung setzen und die Einzelblätter über einen Report erzeugen. Das Ganze würe ohne VBA auskommen. In Deinem Modell hast Du das Problem, wenn der erste beispielsweise mehr als 5 Autos hat, musst Du an die Einzelblätter und an den VBA-Code ran.
Gruß Regina

Beliebteste Forumthreads (12 Monate)

VBA - Zellen aus versch. Blätter

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

241 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA - Zellen aus versch. Blätter

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

241 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread