Copy & Paste Loop - Very Very New to VBA

KJHEXCELL

New Member
Joined
Feb 9, 2019
Messages
6
Hi everyone,

I need some help, I am learning lots but I'm trying to make a loop. I'm trying to get the Range I'm copiyng to move down 3 cells each time and the place pasted down by one.

Copy - A1:A3, A4:A6, A7:A9...etc Paste: G1,G2,G3...etc.

In context, I am coping Name, age & location and transposing it horizontally. I thought this would be the most logical way to do it.

Hope you can help, code below.

Kieran

Sub Test1

Range("A1:A3").Select
Selection.Copy
Range("G1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("A4:A6").Select
Application.CutCopyMode = False
Selection.Copy
Range("G2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Range("A7:A9").Select
Application.CutCopyMode = False
Selection.Copy
Range("G3").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Try this:
Code:
Sub Copy_Transpose()
'Modified  2/9/2019  7:10:02 PM  EST
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Dim x As Long
x = 1
For i = 1 To Lastrow Step 3
    Cells(i, 1).Resize(3).Copy
    Cells(x, "G").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    x = x + 1
Next
Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
I had to add one more line of code try this:
Code:
Sub Copy_Transpose()
'Modified  2/9/2019  7:17:02 PM  EST
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Dim x As Long
x = 1
For i = 1 To Lastrow Step 3
    Cells(i, 1).Resize(3).Copy
    Cells(x, "G").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    x = x + 1
Next
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
 
Upvote 0
Sorry, I am new to the forum this worked perfectly! I was going down the wrong road when I was attempting it. Do you know any good books you would recommend?

Honestly, thank you, I fell asleep after my next post and was up all night trying to figure things out.
 
Upvote 0
Well glad things worked out for you.
If you wanting books or other help.
Look at the header of this Mr. Excel Page and you will see Mr. Excel Store
There are thousands of resources there.
 
Upvote 0

Forum statistics

Threads
1,224,820
Messages
6,181,154
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top