|
dann schau mal ob das so passt. L und R hab ich mal mit reingenommen aber den code nicht zu unleserlich gemacht. das ginge auch noch etwas eingedampfter. Aber du musst ja auch wissen was du da siehst. kannst ja mal eine Rückmeldung geben wie lange es jetzt dauert. Vielleicht sollte man noch die automatische Berechnung ausschalten und das Screenupdating.
Sub austausch()
Dim lrow&, i&
With Sheets("Daten")
lrow = .Cells(Rows.Count, 4).End(xlUp).Row
For i = 4 To lrow Step 11
With .Cells(i, "C")
.Value = .Value
.Offset(2).Resize(5, 1).Value = .Offset(2).Resize(5, 1).Value
End With
With .Cells(i, "L")
.Value = .Value
.Offset(2).Resize(5, 1).Value = .Offset(2).Resize(5, 1).Value
End With
With .Cells(i, "R")
.Value = .Value
.Offset(2).Resize(5, 1).Value = .Offset(2).Resize(5, 1).Value
End With
Next
End With
End Sub
|