Ich habe von Rudi einen Code erhalten und diesen in mein Makro eingebaut. Funktioniert bestens, nur möchte ich auch die Zellformatierung übertragen. Ist das mit arr() möglich und wenn ja wie? Oder geht das nur mit copypaste, was eben sehr langsam ist.
For z = 1 To lastRow - 1
With Sheets(Blattname)
lSpalte = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
Zeile_Hin = .Application.Match("DC Hinfahrt", .Columns(1), 0)
Zeile_Rück = .Application.Match("DC Rückfahrt", .Columns(1), 0)
lZeile = .Cells(.Cells(Zeile_Rück, 1).End(xlUp).Row + 1, 1).Row
arrIn = .Range(.Cells(Zeile_Hin, 1), .Cells(lZeile - 1, lSpalte))
ReDim arrOut(1 To UBound(arrIn), 1 To Application.CountIf(.Rows(Zeile_Hin), arrBlatt(z)) + 1)
End With
For i = 1 To UBound(arrIn)
arrOut(i, 1) = arrIn(i, 1)
Next i
k = 1
For j = 2 To UBound(arrIn, 2)
If arrIn(1, j) = arrBlatt(z) Then
k = k + 1
For i = 1 To UBound(arrIn)
arrOut(i, k) = arrIn(i, j)
Next
End If
Next j
With Worksheets("DC " & arrBlatt(z))
.Cells.ClearContents
.Cells.ClearFormats
.Cells(1, 1).Resize(UBound(arrOut), UBound(arrOut, 2)) = arrOut
End With
Next z
Danke und Gruss
Gregor