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
 

Some videos you may like

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
16,796
Office Version
  1. 2013
Platform
  1. Windows
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:

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
16,796
Office Version
  1. 2013
Platform
  1. Windows
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
 

KJHEXCELL

New Member
Joined
Feb 9, 2019
Messages
6
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.
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
16,796
Office Version
  1. 2013
Platform
  1. Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,108,573
Messages
5,523,672
Members
409,530
Latest member
ZeroTrinder

This Week's Hot Topics

Top