Hallo,
erst ein paar Anmerkungen:
-du hast keinerlei Variablen deklariert, gewöhne dir die konsequente Variablendeklaration von Anfang an bitte an
-ganz oben, noch vor deinem eigentlichen Makro bitte grundsätzlich Option Explicit, das bewirkt, dass alle Variablen deklariert sein müssen, Excel meckert dich dann
sofort an, wenn eine Variable nicht deklariert ist
-in deinem Code läufst du in einer Schleife Zeilenweise über die Spalten und überträgst die Werte auch zeilenweise. Das sollte aus Perfomancegründen möglichst
vermieden werden. Excel braucht z.B. für das kopieren einer einzelnen Zelle in etwa genausoviel Zeit wie für das kopieren von 1000 Zellen im Block
Im angefügten Code hast du jetzt nur noch eine Schleife über die drei Spalten.
Bei jedem Schleifendurchlauf wird in der entsprechenden Spalte die letzte belegte Zeile (von unten nach oben) ermittelt und dann der komplette Bereich in einem Rutsch ins Zielblatt kopiert.
Option Explicit
Sub report()
Dim StartzeileQuelle As Long, EndzeileQuelle As Long, EinfügezeileZiel As Long
Dim Spalte As Variant, Zaehler As Variant
Dim Quelle As Worksheet, Ziel As Worksheet
'Startzeile Kopierbereich Quellblatt
StartzeileQuelle = 11
'Einfügezeile im Zielblatt
EinfügezeileZiel = 5
Set Quelle = ThisWorkbook.Worksheets("Tabelle2") 'Quellblatt festlegen
Set Ziel = ThisWorkbook.Worksheets("Tabelle1") 'Zielblatt festlegen
Zaehler = Array(2, 5, 6)
'Schleife über die Spalten
For Each Spalte In Zaehler
With Quelle
'Ermitteln der letzten belegten Zelle der jeweiligen Spalte
'im Quellblatt
EndzeileQuelle = .Cells(.Rows.Count, Spalte).End(xlUp).Row
'Bereich Startzeile bis Endzeile aus Quellblatt in Zielblatt Einfügezeile kopieren
.Range(.Cells(StartzeileQuelle, Spalte), .Cells(EndzeileQuelle, Spalte)).Copy _
Ziel.Cells(EinfügezeileZiel, Spalte)
End With
Next Spalte
'Variablen wieder freigeben
Set Quelle = Nothing: Set Ziel = Nothing
End Sub
Gruß Werner
|