Kann man das hier noch etwas beschleunigen?
Der Befehl .copy destination:= ... funktioniert ja nicht, da ich Formate und Werte kopieren will. Oder?
'optimale Zeilenhöhe automatisch anpassen
'zunächst kopieren der zusammenhängen Spalten ab C in Spalte U (eizelne Spalte) mitsamt Werten und Formaten
For s = 1 To RangÜbersichtEnde
If s = 1 Then
With Worksheets("Test")
.Range("C" & 32).Copy
.Range("U" & 32).PasteSpecial Paste:=xlValues
.Range("U" & 32).PasteSpecial Paste:=xlFormats
.Rows("32").EntireRow.AutoFit
.Range("C" & 35).Copy
.Range("U" & 35).PasteSpecial Paste:=xlValues
.Range("U" & 35).PasteSpecial Paste:=xlFormats
.Rows("35").EntireRow.AutoFit
.Range("C" & 38).Copy
.Range("U" & 38).PasteSpecial Paste:=xlValues
.Range("U" & 38).PasteSpecial Paste:=xlFormats
.Rows("38").EntireRow.AutoFit
.Range("C" & 41).Copy
.Range("U" & 41).PasteSpecial Paste:=xlValues
.Range("U" & 41).PasteSpecial Paste:=xlFormats
.Rows("41").EntireRow.AutoFit
End With
Else
With Worksheets("Test")
.Range("C" & 32 + i * 34).Copy
.Range("U" & 32 + i * 34).PasteSpecial Paste:=xlValues
.Range("U" & 32 + i * 34).PasteSpecial Paste:=xlFormats
.Rows("32 + i * 34").EntireRow.AutoFit
.Range("C" & 35 + i * 34).Copy
.Range("U" & 35 + i * 34).PasteSpecial Paste:=xlValues
.Range("U" & 35 + i * 34).PasteSpecial Paste:=xlFormats
.Rows("35 + i * 34").EntireRow.AutoFit
.Range("C" & 38 + i * 34).Copy
.Range("U" & 38 + i * 34).PasteSpecial Paste:=xlValues
.Range("U" & 38 + i * 34).PasteSpecial Paste:=xlFormats
.Rows("38 + i * 34").EntireRow.AutoFit
.Range("C" & 41 + i * 34).Copy
.Range("U" & 41 + i * 34).PasteSpecial Paste:=xlValues
.Range("U" & 41 + i * 34).PasteSpecial Paste:=xlFormats
.Rows("41 + i * 34").EntireRow.AutoFit
End With
End If
Next s
Viele Grüße!