Copy/paste range of cells in a column and loop until column ends

[wassmer]

Hi guys,

I recorded a macro but I am unable to take it to the next level and automatize the same procedure until the row ends. I am sure this is an easy problem for most of you:
Range("B2").Select
Range("B2:B49").Select
Selection.Copy
Range("D2").Select
ActiveSheet.Paste
Range("B50:B97").Select
Selection.Copy
Range("E2").Select
ActiveSheet.Paste
Range("B98:B97").Select
Selection.Copy
Range("F2").Select
ActiveSheet.Paste

It is always 48 rows that need to be copied - preferably into another sheet of the same excel file into subsequent columns - 1st 48 values into column A, 2nd 48 values into column B until column B ends.

Thanks so much in advance!

Tom

 

[kevatarvind]

Try This
Sheets name you can change as per yours sheets name where you want to paste data


Sub Copy_Paste()
Set pstrng = Sheets("Sheet2").Range("HO1").End(xlToLeft)
Range("b2").Select
Do Until ActiveCell.Value = ""
Range(ActiveCell, ActiveCell.Offset(47, 0)).Copy pstrng
ActiveCell.Offset(48, 0).Select
Set pstrng = Sheets("Sheet2").Range("HO1").End(xlToLeft).Offset(0, 1)
Loop
End Sub

 

[wassmer]

Thanks a lot kevatarvind!!! - it works! If I want to change the range from 48 values to say 288 values, I would just change 47 to 287, and 48 to 288 right?

 

[kevatarvind]

Thanks a lot kevatarvind!!! - it works! If I want to change the range from 48 values to say 288 values, I would just change 47 to 287, and 48 to 288 right?

Yes Right

 

[wassmer]

Thanks again!

Tom