Sub CopyInEinSheet()
Dim objWksQ As Worksheet
Dim objWksZ As Worksheet
Dim SpalteQ As Long
Dim ZeileZ As Long
Set objWksQ = Worksheets("Tabelle1") 'Tabelle mit Daten in mehreren Spalten
Set objWksZ = Worksheets("Tabelle2") 'Zieltabelle
objWksZ.UsedRange.ClearContents
With objWksQ
'Spaltentitel kopieren
ZeileZ = 1
.Range(.Cells(3, 2), .Cells(3, 3)).Copy Destination:=objWksZ.Cells(ZeileZ, 1)
'Datenblöcke kopieren
For SpalteQ = 2 To .Cells(4, .Columns.Count).End(xlToLeft).Column Step 3
'nächste Einfügezeile im Zielblatt
With objWksZ
ZeileZ = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
End With
.Range(.Cells(4, SpalteQ), .Cells(.Rows.Count, SpalteQ + 1).End(xlUp)).Copy _
Destination:=objWksZ.Cells(ZeileZ, 1)
Next SpalteQ
End With
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen