Difficult Loop

[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 these data rows on Sheet2.
And not just copying one row.
Any Help would be Appreciated
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

 

[Guest]

Sub Newer()
Dim rCell As Range, lastrow as Long
Dim i as Long, j as Long
lastrow = sheet2.cells(rows.count,1).End(xlup).row
j = 2
for i = 1 to lastrow
With Sheet1.Cells(j,1)
For Each rCell In Sheet2.cells(i,1).Resize(1,8)
If IsDate(rCell.Value) Then
'MsgBox rCell.Address & " has " & rCell & " in it" 'Testing
.Value = sheet2.cells(rcell.row,1).Value
Else
.Offset(0, rCell.Value).Value = rCell.Value
End If
Next rCell
j = j + 1
End With

End Sub

 

[MattShoreson]

try something like this (I havent tested it)....

dim lngRow as long
dim lngCol as long
dim lngPasteRow as long
dim lngPasteCol as long
dim tempvalue

lngcol = 1
lngrow = 1
lngpastecol = 1
lngpasterow = 2

with sheets("Sheet1")

do until lngcol > 8

tempvalue = sheets("Sheet2").cells(lngrow,lngcol)

if isdate(tempvalue) then
.cells(lngpasterow,lngpastecol) = tempvalue
lngpasterow = lngpasterow +1
end if

lngcol=lngcol+1

loop
end with

...no doubt people will say it's noddy - but its simple to understand.
You could do it with arrays, dictionaries, ranges or classes, but the
will all do the same thing