2

This is my first day VBA coding, I am trying to copy multiple groups of 3 cells to another location on worksheet and transpose them. Please look the following code for reference:

Range("A4:A6").Select
Selection.Copy
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
Range("A8:A10").Select
Selection.Copy
Range("D2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
Range("A12:A14").Select
Selection.Copy
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
Range("A16:A18").Select
Selection.Copy
Range("D4").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
Range("A20:A22").Select
Selection.Copy
Range("D5").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True

So I want to run this code for next 200 cells. Any suggestions?

marc_s
  • 732,580
  • 175
  • 1,330
  • 1,459
Archit
  • 21
  • 2

2 Answers2

4

You don't need to Select, or even Copy / Paste. This will be faster:

Dim l As Long
For l = 1 To 200
    With Sheet1
        .Cells(l, "D").Resize(1, 3) = Application.Transpose(.Cells(l * 4, "A").Resize(3, 1))
    End With
Next l
Olly
  • 7,749
  • 1
  • 19
  • 38
  • Neat! Must admit I was struggling with this when I tried to write an answer because Application.Transpose didn't seem to return a range so I couldn't then use range.copy. Could you comment plz? Maybe it's a separate question? – Tom Sharpe May 30 '18 at 12:02
  • @TomSharpe Application.Transpose transposes an array - so the line of code above effectively reads in an array from the ("A") specified range, transposes that array, then writes it back to the ("D") specified range. – Olly May 30 '18 at 12:06
  • OK, thanks, got it now, to make my version work I would have had to put rt.value=application.transpose(r) where r is my input range and rt is my output range - embarrassingly basic! – Tom Sharpe May 30 '18 at 12:23
  • Sweet Code! Both answers are good examples of *Resize()* and *Offset()*............also show imaginative looping – Gary's Student May 30 '18 at 12:31
3

This is really a must-read for everyone in the in StackOverflow: How to avoid using Select in Excel VBA

Following its rules and using .Offset():

Public Sub TestMe()

    Dim cnt As Long
    Dim ws As Worksheet: Set ws = Worksheets(1)

    Dim copiedRange As Range: Set copiedRange = ws.Range("A4:A6")
    Dim targetRange As Range: Set targetRange = ws.Range("D1")

    For cnt = 1 To 20 'or 200
        copiedRange.Copy
        targetRange.PasteSpecial Paste:=xlPasteAll, Transpose:=True

        Set copiedRange = copiedRange.Offset(4)
        Set targetRange = targetRange.Offset(1)

    Next cnt
    Application.CutCopyMode = False

End Sub

MSDN Range.Offset Property

Vityata
  • 42,633
  • 8
  • 55
  • 100