Loop Problem

[smandula]

The following code copies only one line from Sheet2 to Sheet1.
How can you loop the macro to copy all data in Sheet2 to Sheet1.

What the Macro does is copies Date and 7 numbers to Sheet1. The seven
numbers are any numbers to 39 in any order. Arranged to Column Number
such as Col. B would have number 1; Col. K would have number 10;
and so on to number 39 Col. AN.

The problem is looping thur this data on Sheet2.
With Thanks

Sub Newer()
Dim rCell As Range
With Sheet1.Range("A2") 'Header row has description row one
For Each rCell In Sheet2.Range("A1:H1")
If IsDate(rCell.Value) Then
'MsgBox rCell.Address & " has " & rCell & " in it" 'Testing
.Value = Sheet2.Range("A1")
Else
.Offset(0, rCell.Value).Value = rCell.Value
End If
Next rCell
End With

End Sub

 

[Dick Kusleika]

Sub Newer2()
Dim rCell As Range
Dim rCell2 As Range

For Each rCell2 In Sheet2.Range("A1:A100") 'adjust for how many rows you
want to copy
With Sheet1.Range(rCell2.Offset(1,0).Address) 'Header row has
description row one
.Value = rCell2.Value
For Each rCell In rCell2.Offset(0,1).Resize(1,7) 'change the 7 to
cover all the columns you need
'MsgBox rCell.Address & " has " & rCell & " in it" 'Testing
.Offset(0, rCell.Value).Value = rCell.Value
Next rCell
End With
Next rCell2

End Sub

 

[smandula]

Thanks a Million Million!
The Macro is excellent.

It saves a tremenduous amount of manual keying