Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Copy worksheets from multiple files in one folder to on main workbook. 2

Status
Not open for further replies.

bodo62

Programmer
Jun 29, 2004
23
SE
Hello all.

I have let's say 3 files with one sheet each, all sheets have the same name as the workbook names which contains them (they are generated automatically by another program each month and saved into one folder).

Example: In the folder we have files SA_SE.XLS, SA_US.XLS and SA_DE.XLS with sheet names SA_SE, SA_US and SA_DE.

I want the code to copy those 3 sheets into one workbook (let's name it Overview.xls).

The number of files vary from one month to another and in this case I need the Overview.xls to always be emptied from the old sheets, before the code copies the new sheets into it.

How do I loop through the folder containing the workbooks, and then copy each worksheet from the them into the Overview workbook ?

All help appreciated.
 
Hi
This should give you a start at least!

Code:
Sub CopySheetsFromFolder()
Dim oFSO As Object
Dim oFld As Object
Dim f As Object
Dim wbMe As Workbook
Dim wbTWO As Workbook
Dim i As Integer

Set wbMe = ThisWorkbook
'get rid of all sheets in this book apart from the first
'Workbook MUST contain at least 1 sheet
Application.DisplayAlerts = False
For i = wbMe.Sheets.Count To 2 Step -1
    Sheets(i).Delete
Next
Application.DisplayAlerts = True

Set oFSO = CreateObject("scripting.filesystemobject")
Set oFld = oFSO.getfolder("X:\YourFolder\YourSubFolder\etc etc")

'loop thru the files in the folder
For Each f In oFld.Files
    'check they're xl files then open & copy & close
    If f.Name Like "*.xls" Then
        Set wbTWO = Workbooks.Open(oFld & "\" & f.Name, True)
        wbTWO.Worksheets(1).Copy after:=wbMe.Worksheets(wbMe.Worksheets.Count)
        'the line above can be changed to this
        'wbTWO.Worksheets(Left(f.Name, Len(f.Name) - 4)).Copy _
            after:=wbMe.Worksheets(wbMe.Worksheets.Count)
        wbTWO.Close True
    End If
    Set wbTWO = Nothing
Next

Set wbMe = Nothing
Set oFSO = Nothing
Set oFld = Nothing
Set f = Nothing

End Sub

;-)

If a man says something and there are no women there to hear him, is he still wrong? [ponder]
The faqs ma'am, just the faqs. Get the best from these forums : faq222-2244
 
Great!

Thanks Loomah, that helped a lot! [thumbsup]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top