|
Hallo Roland,
das wäre dann so möglich:
Sub atkuell_erstellenNEU()
Dim old As Object, Ziel As Object
Dim Spalten, Spalte, Zielspalte As Long
Spalten = Array("I:I", "AG:AG", "O:O", "B:B", "H:H", "S:S", "AH:AH", "Z:Z")
Set old = ThisWorkbook.Sheets("IX")
Set Ziel = ThisWorkbook.Sheets("Akutell")
Spalten = Array("I1:I" & old.Cells(Rows.Count, 9).End(xlUp).Row, "AG1:AG" & old.Cells(Rows.Count, 33).End(xlUp).Row, "O1:O" & old.Cells(Rows.Count, 15).End(xlUp).Row, "B1:B" & old.Cells(Rows.Count, 2).End(xlUp).Row, "H1:H" & old.Cells(Rows.Count, 8).End(xlUp).Row, "S1:S" & old.Cells(Rows.Count, 19).End(xlUp).Row, "AH1:AH" & old.Cells(Rows.Count, 34).End(xlUp).Row, "Z1:Z" & old.Cells(Rows.Count, 26).End(xlUp).Row)
Application.ScreenUpdating = False
Zielspalte = 1
With Ziel
For Each Spalte In Spalten
old.Range(Spalte).Copy
.Cells(1, Zielspalte).PasteSpecial xlPasteColumnWidths
.Cells(1, Zielspalte).PasteSpecial xlPasteFormats
.Cells(1, Zielspalte).PasteSpecial Paste:=xlPasteAllMergingConditionalFormats
.Cells(1, Zielspalte).PasteSpecial xlPasteValues
Zielspalte = Zielspalte + Range(Spalte).Columns.Count
Next Spalte
Application.CutCopyMode = False
End With
End Sub
Es wird für jede zu kopierende Spalte die Zellenzahl einzeln ermittelt.
Gruß Uwe
|