transferring daily numbers to a master sheet

[John7385]

Hi There,

I am looking for a way to transfer my daily work schedules to a monthly worksheet.

Basically a daily sheet would look something like below but there would be around 100 entries per sheet and 8 sheets (1 for each member of staff):

Call Scheme Type Client PolicyNumber Dialled Outcome sales Comments Leads P-Care K-Care
Outbound Home Lead 390757 Yes Taken Up 1 renewed
Outbound Home Lead 413179 Yes No answer
Outbound Home Lead 282296 Yes
Outbound Home Lead 280407 No
Outbound Home Lead 52474 No
Outbound Equipment Renewal 412146 DN0150045 Yes
Outbound Equipment Renewal 314803 DG112446
Outbound Equipment Renewal 412723 MSI0150292
Outbound Full Cover Renewal 373342 FC0119690
Outbound Equipment Renewal 179238 MSI0135508

All I would like to be able to do is have each entry copy over to a master sheet so at the end of the month I would have all the entries in one place. To achieve this at the moment I am having to copy and paste all 8 sheets to a master sheet each day!

Any help would be greatly appreciated

John

 

[My Aswer Is This]

Is all this data in column "A" ?

 

[John7385]

Is all this data in column "A" ?

Hi, sorry no column A would be:

(Heading) CALL

Outbound
Outbound
Outbound

Column B :

(Heading) SCHEME

HOME
HOME
Equipment

Etc

Cheers

 

[John7385]

Hi, sorry no column A would be:

(Heading) CALL

Outbound
Outbound
Outbound

Column B :

(Heading) SCHEME

HOME
HOME
Equipment

Etc

Cheers

I have made an attempt using the following VB Code:

Can anybody advise where I am going wrong?

Folder where sheets all sheets are held:

C:\Users\traynorj\Desktop\masterfolder

Sheet Names:
Master
TestDay1
TestDay2



This is the code I have used:



Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
MyFile = Dir("C:\Users\traynorj\Desktop\masterfolder\")

Do While Len(MyFile) > 0
If MyFile = "Master.xlsx" Then
Exit Sub
End If

Workbooks.Open (MyFile)
Range("A1:O200").Copy
ActiveWorkbook.Close

ero = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("sheet1").Range(Cells(erow, 1), Cells(erow, 200))

MyFile = Dir

Loop



End Sub