Search code examples
vbaimacros

how to increase ranges in loop with vba?

Sub Worksheet_Change()

Set Target = ActiveCell
Application.ScreenUpdating = False

[A1:F20].Copy
[H4].PasteSpecial Paste:=xlPasteValues, Transpose:=True

[A22:F42].Copy
[H24].PasteSpecial Paste:=xlPasteValues, Transpose:=True

[A44:F64].Copy
[H46].PasteSpecial Paste:=xlPasteValues, Transpose:=True

[A66:F86].Copy
[H68].PasteSpecial Paste:=xlPasteValues, Transpose:=True

[A88:F108].Copy
[H90].PasteSpecial Paste:=xlPasteValues, Transpose:=True

[A110:F130].Copy
[H112].PasteSpecial Paste:=xlPasteValues, Transpose:=True

[A132:F152].Copy
[H134].PasteSpecial Paste:=xlPasteValues, Transpose:=True

[A154:F174].Copy
[H156].PasteSpecial Paste:=xlPasteValues, Transpose:=True

[A176:F196].Copy
[H178].PasteSpecial Paste:=xlPasteValues, Transpose:=True

[A198:F218].Copy[H200].PasteSpecial Paste:=xlPasteValues, Transpose:=True

Application.CutCopyMode = False
Target.Select

End Sub
Solution

  • you may try this:

    Application.ScreenUpdating = False

[A1:F20].Copy
[H4].PasteSpecial Paste:=xlPasteValues, Transpose:=True

With [A22:F42]
    For i = 1 To 9
        .Offset((i - 1) * 22).Copy
        [H24].Offset((i - 1) * 22).PasteSpecial Paste:=xlPasteValues, Transpose:=True
        Application.CutCopyMode = False
    Next i
End With

Application.ScreenUpdating = True