nach eurer erfolgreichen Hilfe von letzter Woche komme ich nun leider wieder nicht weiter. Folgende Aufgabe: Ich möchte die Bereiche A2:ABXX aus aktuell 12 Tabellenblättern in das Sheet Datengrundlage gesamt kopieren. Die Daten sollen alle untereinander in die jeweils nächste Zeile kopiert werden. Mein Code funktioniert auch aktuell. Allerdings mit der Einschränkung, dass durch den aktuellen Kopiervorgang immer der vorherige überschrieben wird. Am Ende wurde also nur der Datenbereich aus dem letzten KST-Sheet übernommen. Ich habe schon mit einer Fornext Schleife gebastelt, lande aber immer wieder im Debugger. Was muss ich tun, damit am Ende alle Daten aus allen 12 Sheets untereinander stehen?
Nachfolgend noch mein Code:
Sub auswählen()
'Variablen Deklaration
Dim nextrow As Long
Dim lastrow1 As Long
Dim lastrow2 As Long
Dim lastrow3 As Long
Dim lastrow4 As Long
Dim lastrow5 As Long
Dim lastrow6 As Long
Dim lastrow7 As Long
Dim lastrow8 As Long
Dim lastrow9 As Long
Dim lastrow10 As Long
Dim lastrow11 As Long
Dim lastrow12 As Long
Dim M01000 As Worksheet
Dim M20000 As Worksheet
Dim M21000 As Worksheet
Dim M25000 As Worksheet
Dim M32210 As Worksheet
Dim M32250 As Worksheet
Dim M51200 As Worksheet
Dim M52400 As Worksheet
Dim M67100 As Worksheet
Dim M69100 As Worksheet
Dim M71000 As Worksheet
Dim M72000 As Worksheet
Dim M73000 As Worksheet
Dim Datengrundlagegesamt As Worksheet
'Variablen zuweisung
Set M01000 = Worksheets("M01000")
Set M20000 = Worksheets("M20000")
Set M21000 = Worksheets("M21000")
Set M25000 = Worksheets("M25000")
Set M32210 = Worksheets("M32210")
Set M32250 = Worksheets("M32250")
Set M51200 = Worksheets("M51200")
Set M52400 = Worksheets("M52400")
Set M67100 = Worksheets("M67100")
Set M69100 = Worksheets("M69100")
Set M71000 = Worksheets("M71000")
Set M72000 = Worksheets("M72000")
Set M73000 = Worksheets("M73000")
Set Datengrundlagegesamt = Worksheets("Datengrundlage gesamt")
nextrow = Datengrundlagegesamt.Range("A65536").End(xlUp).Row + 1
lastrow1 = M01000.Range("A65536").End(xlUp).Row - 2
lastrow2 = M20000.Range("A65536").End(xlUp).Row - 2
lastrow3 = M25000.Range("A65536").End(xlUp).Row - 2
lastrow4 = M32210.Range("A65536").End(xlUp).Row - 2
lastrow5 = M32250.Range("A65536").End(xlUp).Row - 2
lastrow6 = M51200.Range("A65536").End(xlUp).Row - 2
lastrow7 = M52400.Range("A65536").End(xlUp).Row - 2
lastrow8 = M67100.Range("A65536").End(xlUp).Row - 2
lastrow9 = M69100.Range("A65536").End(xlUp).Row - 2
lastrow10 = M71000.Range("A65536").End(xlUp).Row - 2
lastrow11 = M72000.Range("A65536").End(xlUp).Row - 2
lastrow12 = M73000.Range("A65536").End(xlUp).Row - 2
'Kopieren und Einfügen von Daten M01000
M01000.Activate
M01000.Range(Cells(7, 1), Cells(lastrow1, 28)).Copy
Datengrundlagegesamt.Cells(Rows.Count + 1, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Kopieren und Einfügen von Daten M20000
M20000.Activate
M20000.Range(Cells(7, 1), Cells(lastrow2, 28)).Copy
Datengrundlagegesamt.Cells(nextrow, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Kopieren und Einfügen von Daten M25000
M25000.Activate
M25000.Range(Cells(7, 1), Cells(lastrow3, 28)).Copy
Datengrundlagegesamt.Cells(nextrow, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Kopieren und Einfügen von Daten M32210
M32210.Activate
M32210.Range(Cells(7, 1), Cells(lastrow4, 28)).Copy
Datengrundlagegesamt.Cells(nextrow, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Kopieren und Einfügen von Daten M32250
M32250.Activate
M32250.Range(Cells(7, 1), Cells(lastrow4, 28)).Copy
Datengrundlagegesamt.Cells(nextrow, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Kopieren und Einfügen von Daten M51200
M51200.Activate
M51200.Range(Cells(7, 1), Cells(lastrow4, 28)).Copy
Datengrundlagegesamt.Cells(nextrow, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Kopieren und Einfügen von Daten M52400
M52400.Activate
M52400.Range(Cells(7, 1), Cells(lastrow4, 28)).Copy
Datengrundlagegesamt.Cells(nextrow, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Kopieren und Einfügen von Daten M67100
M67100.Activate
M67100.Range(Cells(7, 1), Cells(lastrow4, 28)).Copy
Datengrundlagegesamt.Cells(nextrow, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Kopieren und Einfügen von Daten M69100
M69100.Activate
M69100.Range(Cells(7, 1), Cells(lastrow4, 28)).Copy
Datengrundlagegesamt.Cells(nextrow, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Kopieren und Einfügen von Daten M71000
M71000.Activate
M71000.Range(Cells(7, 1), Cells(lastrow4, 28)).Copy
Datengrundlagegesamt.Cells(nextrow, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Kopieren und Einfügen von Daten M72000
M72000.Activate
M72000.Range(Cells(7, 1), Cells(lastrow4, 28)).Copy
Datengrundlagegesamt.Cells(nextrow, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'Kopieren und Einfügen von Daten M73000
M73000.Activate
M73000.Range(Cells(7, 1), Cells(lastrow4, 28)).Copy
Datengrundlagegesamt.Cells(nextrow, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub
Wie ihr sehen könnt, bin ich noch recht grün hinter meinen VBA Ohren und aus diesem Grund für jeden Tipp dankbar. Vielleicht hat auch jemand eine Idee, wie ich meinen Code kürzer schreiben kann? Besten Dank vorab!Grüße
Matthias