Looping Paste Special Value Transpose

[AncientLearner]

I am trying to create a macro that will loop through list of items containing
4 columns and Paste Special Values Transpose into a Single column on a blank
worksheet. My problem is that Col C & D are blanks, so I need to step down 4
rows with each paste.

PartNo-Qty-Blank1-Blank2

I need it to be:

PartNo
Qty
Blank1
Blank2
PartNo
Qty
Blank1
Blank2

 

[Jim Thomlinson]

This should be close. It takes all of the cells in sheet1 columns A and B amd
copies them to Sheet2 column A in the manner you describe...

Sub test()
Dim rngFrom As Range
Dim rngTo As Range
Dim rng As Range

With Sheets("Sheet1")
Set rngFrom = .Range(.Range("A2"), .Cells(Rows.Count, "A").End(xlUp))
End With

Set rngTo = Sheets("Sheet2").Range("A2")

For Each rng In rngFrom
rngTo.Value = rng.Value
rngTo.Offset(1, 0).Value = rng.Offset(0, 1).Value
Set rngTo = rngTo.Offset(4, 0)
Next rng

End Sub

 

[AncientLearner]

Wow...I am in heaven after countless hours of frustration.
Thank you from the bottom of my old heart Fabulous!