Hi mandela
okay i can give you some code that will combine each week's worth of
information onto a separate sheet in the workbook. Therefore, you'll end up
with 52 sheets in the combined workbook.
to do this
1) close all open workbooks but leave excel open - open a new workbook
2) choose tools / options / general - change sheets in a new workbook to
52 - close the open workbook
3) open a new workbook - it will have 52 sheets .. save it calling it
combined.xls
4) choose tools / options / general - change sheets in a new workbook back
to 3
5) right mouse click on sheet1's tab and choose view code
6) in the VBE editor widow choose insert / module from the menu
7) in the white piece of paper on the right copy & paste in the following:
'---
Sub namesheets()
Sheets(1).Activate
For i = 1 To 52
Sheets(i).Name = "Week" & i
Next
End Sub
'----
this will rename the sheet tabs for you - click inside the code and press
the F5 key, this will run the code
8)press Alt & F11 to get back to the workbook
9) go to sheet1 (now called week1) and put in the text ... the following
code will only add up the numbers, so you need to copy in any text you want
on each page and remove all numbers.
10) once sheet1 is correct, click on the week1 tab, hold down the shift key
and click on week52's tab, - let the shift key go, now select the active
area of week1 (the bit you typed in in step 9) and choose edit / fill across
worksheets ... now every sheet should look the same ... click on a few to
check
11) use alt & F11 to go back into the code... copy and paste the following
under the end sub of the previous lot of code
Sub findfile()
Dim fname As String
Dim fname2 As String
Dim pname As String
Dim dval
Dim i As Long
fname = "*.xls" 'filename
pname = "c:\temp\excel" 'folder to use
Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn = pname
.SearchSubFolders = False
.Filename = fname 'check to see if any files match the fname
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(i)
fname = ActiveWorkbook.Name
If Len(fname) = 15 Then
fname2 = "0" & fname
Else
fname2 = fname
End If
dval = "" & Left(fname2, 2) & "/" & Mid(fname2, 3, 3) & "/"
& Mid(fname2, 6, 2) & ""
dval = CDate(dval)
Select Case dval
Case Is <= (37895 + 6)
sname = "Week1"
Case Is <= (37895 + 13)
sname = "Week2"
Case Is <= (37895 + 20)
sname = "Week3"
Case Is <= (37895 + 27)
sname = "Week4"
Case Is <= (37895 + 34)
sname = "Week5"
Case Is <= (37895 + 41)
sname = "Week6"
Case Is <= (37895 + 48)
sname = "Week7"
Case Is <= (37895 + 56)
sname = "Week8"
Case Is <= (37895 + 63)
sname = "Week9"
Case Is <= (37895 + 70)
sname = "Week10"
Case Is <= (37895 + 77)
sname = "Week11"
Case Is <= (37895 + 84)
sname = "Week12"
'need to follow the same pattern for all 52 weeks
End Select
Range("A1:L20").Select
Selection.Copy
Windows("combined.xls").Activate
Sheets(sname).Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd,
SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Workbooks(fname).Close
Next
End If
End With
Application.ScreenUpdating = True
End Sub
'---
this is set up to do up to week 12 .. there's probably a neater way to do it
but i can't see it, so you'll need to add more lines in basically adding 7
to the number after the + and incrementing the week number until you get to
52
then once you've done that change
pname = "c:\temp\excel" 'folder to use
to the folder with these 365 files in (make sure there are no other files in
there)
and then click on the code and press F5
it might take awhile to run but what it should do, is open each file in
turn, check the date, and copy the information from sheet1 to the
appropriate week.
(note, you might want to test it on only a month's worth of files to start
with - so only have these in the folder when you run it)
Let me know how you go with this.
Cheers
JulieD
