VBA - Combine Workbooks

[jordanctc]

I have got 40 separate files in a folder. One for each month from Ma
2000 to Sept 2004 - All named like "yyyy mm SRnA.xls". Every file ha
only a single sheet. Is there a way in VBA to loop through all file
to create a copy of all sheets in one new workbook?

Thanks,
Jorda

 

[Ron de Bruin]

Hi jordanctc

Try this
http://www.rondebruin.nl/copy3.htm

 

[Clayton McGuire]

I should warn that this is COMPLETELY untested. Prerequisites for it
to work:

- you need to change the path to the directory you want to use (could
be done in a more fancy way with a dialog choosing the path etc, but
there's plenty of other posts on that so I've just gone simple the
hardcoded option);
- it assumes that all the files in the directory will be *.xls files.
If you have other stuff in there it will still try to open it, and
then fall on it's bum. If you are likely to have other files in there
you probably want to do a test that it's a valid Excel file before
opening it;
- the single sheet in the thing you're trying to combine shouldn't be
called Sheet1. I've got a feeling that when you try to copy it, it
will have a fit because it has a conflicting name (again, I haven't
tested it to be sure). The sheets will be renamed to match the sheet
name in the file you have after it's been copied.

Hope this helps,

Clayton.

==========================================

Option Explicit

Sub prcCombineFiles()
Dim wbkTarget As Workbook
Dim wbkSource As Workbook
Dim strSource As String
Dim strPathName As String
Dim lngSheetNumber As Long

strPathName = "C:\" 'insert the folder with the files here

Set wbkTarget = Workbooks.Add

Application.DisplayAlerts = False
Do Until wbkTarget.Sheets.Count = 1
wbkTarget.Sheets(2).Delete
Loop
Application.DisplayAlerts = True

lngSheetNumber = 1
strSource = Dir(strPathName)
Do Until Len(strSource) = 0
Set wbkSource = Workbooks.Open(strSource)
wbkSource.Sheets(1).Copy
after:=wbkTarget.Sheets(lngSheetNumber)
lngSheetNumber = lngSheetNumber + 1
wbkTarget.Sheets(wbkTarget.Sheets.Count).Name =
wbkSource.Sheets(1).Name
wbkSource.Close SaveChanges:=False
Loop
Application.DisplayAlerts = False
wbkTarget.Sheets(1).Delete
Application.DisplayAlerts = True
End Sub