Copy & Paste Transpose in Another Sheet

[dgr]

Hi,
I'm using Excel 2013.

I would like to copy every 150 rows of data from column A of Sheet 1 & paste special in a transpose manner into Sheet 2. I would like this process to go on until there is no more data in Sheet 1 to copy. The end result should be all data is pasted in Sheet 2 in a transpose manner & there should no longer be any data in Sheet 1.

I've gone as far as creating this macro which works fine but doesn't seem to loop. Could you please help me to edit this code so that it loops until there is no more data in Sheet 1 to copy?

Thanks.

Sub test()

ActiveSheet.Name = "Sheet1"
    Dim wsData As Worksheet
    Dim wsNew As Worksheet
    Dim rng As Range
    Dim I As Long
     
    Set wsData = Worksheets("Sheet1")
    Set wsNew = Worksheets("Sheet2")
     
    Set rng = wsData.Range("A1")
    While rng.Value <> ""
        I = I + 1
        rng.Resize(150).Copy
        wsNew.Range("A" & I).PasteSpecial xlPasteValues, Transpose:=True
        Set rng = rng.Offset(150)
    Wend
End Sub

 

[VoG]

Try

Sub test()

    Dim wsData As Worksheet
    Dim wsNew As Worksheet
    Dim rng As Range
     
    Set wsData = Worksheets("Sheet1")
    Set wsNew = Worksheets("Sheet2")
     
    Set rng = wsData.Range("A1")
    While rng.Value <> ""
        rng.Resize(150).Copy
        wsNew.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues, Transpose:=True
        Set rng = rng.Offset(150)
    Wend
End Sub

 

[dgr]

Thanks a lot VoG. This is exactly what I was looking for. I appreciate your help. Have a blessed day