Seemingly a simple quest, however i think i have got into a muddle
with it. I have 2 worksheets "daily" and "4 Weekly" I want to copy
columns from the daily sheet into the 4 weekly sheet into the
relevant column depending on the date and every 10 rows.
ie the details below show the idea of what i need. I can get it to
go in the right colum depending on the date and i can get things to
copy every 10 rows, but i cant seem to get it to do it together.

Daily sheet
ORANGE JUICE 15
APPLE JUICE 17
YOGURT 25

4 Weekly sheet
Mon1, Tue1,
ORANGE JUICE STOCK
USED 15
SOLD
APPLE JUICE STOCK
USED 17
SOLD

This is what i have
Sub TRANSFEROFINFO1()
'this is the bit that gets the info into the right line of the 4
weekly sheet by using the prgm below'

'Attempt at copying info from one sheet to another Macro recorded
6/6/2006 by CarmenN

Dim LDate As String
Dim LColumn As Integer
Dim LFound As Boolean

On Error GoTo Err_Execute

'Retrieve date value to search for

LDate = Sheets("Daily").Range("e2").Value

Sheets("4 Week Stock").Select

'Start at Column C
LColumn = 3
LFound = False

While Not LFound

'Encountered blank cell in row 3, terminate search
If Len(Cells(3, LColumn)) = 0 Then
MsgBox "no data is found, have you set the date?"
Exit Sub

'Found match in row 3, so copy information from data sheet into
spreadsheet.

ElseIf Cells(3, LColumn) = LDate Then
'copy daily figures into main 4 weekly sheet using a combination of
2 programs merged together- hopefully

Dim CurrRow As Long, ToCol As Integer
Const FromSht = "Dairy" 'source sheet
Const FromCell = "I6" 'first cell of source data

Const ToSht = "4 week stock" 'destination sheet
Const ToCell = "C7" 'where FromCell should go

CurrRow& = Range(ToCell).Row
ToCol% = Range(ToCell).Column
Sheets(FromSht).Activate
Range(FromCell).Activate
Do While Len(ActiveCell.Value) > 0
Application.Sheets(ToSht).Cells(CurrRow&, ToCol%).Value =
ActiveCell.Value
CurrRow& = CurrRow& + 10
ActiveCell.Offset(1, 0).Activate
Loop




LFound = True
MsgBox "The data has been successfully copied, have a nice day!"

'Continue searching
Else
LColumn = LColumn + 1
End If

Wend
On Error GoTo 0

Exit Sub

Err_Execute:
MsgBox "An error has occurred please contact Carmen on 231."

End Sub
It doesnt work though as all i get is the error message. I hope you
can help.