Give this a try. Make sure the constants are at the very top of the code
module. It is the exact same code just re-arranged a bit. It compiles at this
end so it should be ok...

Private Const IntRows As Integer = 52 'Must be at top of code window
Private Const intColumns As Integer = 3 'Must be at top of code window

Sub MoveRows()
Dim wksFrom As Worksheet
Dim wksTo As Worksheet
Dim rngFrom As Range
Dim rngToData As Range
Dim rngToTitles As Range
Dim rngTitles As Range
Dim rngLastItem As Range

Set wksFrom = Sheets("Sheet2") 'Change The Sheet Name
Set wksTo = Worksheets.Add
Set rngTitles = wksFrom.Range("A1:B1")
Set rngToTitles = wksTo.Range("A1")
Set rngLastItem = wksFrom.Range("A65536").End(xlUp)
Set rngFrom = wksFrom.Range(wksFrom.Cells(2, 1), _
wksFrom.Cells(IntRows + 1, 2))
Set rngToData = wksTo.Range("A2")

Do While Intersect(rngFrom, rngLastItem) Is Nothing
rngFrom.Copy rngToData
rngTitles.Copy rngToTitles
Set rngFrom = rngFrom.Offset(IntRows, 0)
Set rngToData = rngToData.Offset(IntRows, intColumns)
Set rngToTitles = rngToTitles.Offset(0, intColumns)
Loop
End Sub


--
HTH...

Jim Thomlinson


"New2VBA" wrote:

I wish I could say it looks good, but I don't understand much. I do
know however that it is not working. I get an error message: "Compile
Error - Expected End Sub"

Let me know what I am missing.

Thanks