Sub Test()
Dim myRange As Range
Dim ro As Integer
Dim co As Integer
Dim aa, xx, bb As Integer
Dim varA As String

Set myRange = Worksheets("Sheet1") _
.Range("A1").CurrentRegion
ro = myRange.Rows.Count
co = myRange.Columns.Count
Set ther = Worksheets("Sheet2").Range("A2")
For aa = 2 To ro
For x = 1 To 11
For bb = 1 To co
varA = Worksheets("Sheet1").Cells(aa, bb).Value
ther.Offset(aa - 2, bb - 1).Value = varA
Next bb
Next x
' Pointer needs to drop down one row
Next aa
End Sub

--
Regards,
Tom Ogilvy


--
Regards,
Tom Ogilvy


"Arturo" wrote in message
...
Looping and Offset
My current dataset is 4 columns by 10 rows in sheet1.
I need to copy each record 11 times into sheet2.
Field headings are the same on both.
Here's what I've been tripping over:

Sub Test()
Dim myRange As Range
Dim ro As Integer
Dim co As Integer
Dim aa, xx, bb As Integer
Dim varA As String

Set myRange = ActiveSheet.Range("A1").CurrentRegion
ro = myRange.Rows.Count
co = myRange.Columns.Count
Set ther = Worksheets("Sheet2").Range("A2")
For aa = 2 To ro
For x = 1 To 11
For bb = 1 To co
varA = Worksheets("Sheet1").Cells(aa, bb).Value
' MsgBox "Row: " & aa & Chr(13) & Chr(13) & "Data: " & varA
ther.Value = varA
' Offset does not work properly
Set ther = ther.Offset(0, bb)
' MsgBox ther.Address
Next bb
Next x
' Pointer needs to drop down one row
Next aa
End Sub


Appreciatively!
Arturo