Automatically copy multiple workbooks into one

[sizzi09]

Hi Everyone,
I am attempting my first working macro and need some help. I am currently using Excel 2010 on Windows XP. Here is what I am attempting: I need a very user friendly macro that will allow my staff to click on a button to run the macro. Each month they receive multiple workbooks from one of our clients. The workbooks are always stored in the same location. I need the macro to go in and pick up the first worksheet of each workbook and copy it into a new workbook. Each original sheet1 of each workbook should have its own sheet in the new workbook, i.e. if there are 5 original workbooks then the macro should create one workbook with 5 sheets. Here is the programming I have been using:

Sub GetSheets()
Path = "C:\Documents and Settings\e462863\My Documents\nutterblotter\"
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub

This works, but I am running into a few problems. I need to create a "run" button but I'm unsure how to build it. Also, when I run this macro there are tons of extra sheets and the worksheets tend to duplicate. I am wondering if the "loop" is picking up more than I need.

Any help is really appreciated! Thanks in advance!

 

[pboltonchina]

To create a 'Run' button just insert the shape you want on the sheet, where you want it. Right click the shape and select 'Assign Macro', then select your macro.

Your macro is asking for all sheets, do the sheets you want all have the same name in the different books or are they in the same position in the book?

 

[sizzi09]

To create a 'Run' button just insert the shape you want on the sheet, where you want it. Right click the shape and select 'Assign Macro', then select your macro.

Your macro is asking for all sheets, do the sheets you want all have the same name in the different books or are they in the same position in the book?

Good morning,
Thanks so much for responding. The sheets are not named, other than the default "sheet1". I would like to only pick up "sheet1" in all of the workbooks. All of the information is in the exact same postion in each workbook.

 

[pboltonchina]

Try changing this

For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)

to this

ActiveWorkbook.Sheets(1).Copy After:=ThisWorkbook.Sheets(1)

 

[sizzi09]

This works perfectly! Thanks so much for your help.

Can I ask one more question?

Is there another macro I could build that will Clear the entire workbook? We have to run this macro every month with new data, it would be nice to easily assign a "Clear" macro to a button.

I also was able to build the button to run the macro - thanks again for the tip, I couldn't remember exactly how to do it from the class I took about a year ago.

 

[pboltonchina]

Where does your macro reside in the workbook, is it in a module or a sheet? You need to keep one sheet in the workbook that has the macro button on it, what is the name of that sheet?

 

[sizzi09]

Where does your macro reside in the workbook, is it in a module or a sheet? You need to keep one sheet in the workbook that has the macro button on it, what is the name of that sheet?

I started with it in a module and then created a button on a worksheet I named "run macro". The macro is still available in the module though.

 

[pboltonchina]

Try this on a copy of your data as it is untested

Sub GetSheets()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For Each WS In ThisWorkbook.Worksheets
                If WS.Name <> "run macro" Then WS.Delete
End If
Next WS
Path = "C:\Documents and Settings\e462863\My Documents\nutterblotter\"
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
ActiveWorkbook.Sheets(1).Copy After:=ThisWorkbook.Sheets(1)
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[sizzi09]

Good morning,
Thanks for sending over this code. I tried to run it, but I keep getting an error message. The "End If" is highlighted and the message reads "compile error: End If without block If". I'm not sure how to fix this.

Try this on a copy of your data as it is untested

Sub GetSheets()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For Each WS In ThisWorkbook.Worksheets
                If WS.Name <> "run macro" Then WS.Delete
End If
Next WS
Path = "C:\Documents and Settings\e462863\My Documents\nutterblotter\"
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
ActiveWorkbook.Sheets(1).Copy After:=ThisWorkbook.Sheets(1)
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[pboltonchina]

Delete the End If that is highlighted