PDA

View Full Version : Solved: Merge Workbooks



parttime_guy
01-17-2006, 07:48 PM
Hi Guz

Assuming I have 5 sheets (different names) in the 1st workbook and 7 sheets (different names) in the 2nd workbook (I have 30+ such workbooks in the same path), but how do I copy all sheets in the said workbooks with their respective sheet names into the final/master workbook, another thing if any of the workbooks have blank sheets will it skip those - plz help

Thx-n-BR

parttime_guy
01-19-2006, 08:02 PM
Sub CombineBooks()
'adds the first worksheet from all files in a particular directory
'to the active workbook

Dim CurFile As String
Dim NWB, OWB As Workbook

'change this line to indicate the folder
Const FileFolder = "C:\TestResults"

'remeber which workbook is active at the start
Set OWB = ActiveWorkbook
'get name of first workbook in specified folder
CurFile = Dir(FileFolder & "\*.xls")

Do While CurFile <> ""
'open first workbook
Set NWB = Workbooks.Open(FileFolder & "\" & CurFile)
'copy first sheet to original workbook
NWB.Worksheets(1).Copy _
after:=OWB.Worksheets(OWB.Worksheets.Count)
'close workbook without saving changes
NWB.Close (False)
'get next workbook
CurFile = Dir()
Loop
End Sub

The above code works fine with copy and pasting only the first sheet of each workbook. But how do I copy all sheets in the said workbooks with their respective sheet names into the final/master workbook, another thing if any of the workbooks have blank sheets will it skip those - plz help

XLGibbs
01-19-2006, 09:04 PM
With NWB
For each Ws in Worksheets
Ws.Copy after:=OWB.Worksheets(OWB.Worksheets.Count)
Next Ws
End With

A loop like that would cycle through the worksheets, does that get you closer?

You could an IF Else to handle determining a blank sheet

something like :
If Not IsEmpty(Ws.Cells(1,1) then
Ws.Copy....etc
End if

malik641
01-19-2006, 11:16 PM
Hey parttime_guy :hi:

Just so you know in your code NWB was not set as a workbook, but as a Variant. Unfortunately you have to declare each variable (unless it's a variant) after its name...like: Dim NWB As Workbook, OWB As Workbook

But anyway I didn't test this but give it a shot...it should work. :thumb

Sub CombineBooks_for_You()
'Adds all worksheets from all files into one HUGE workbook :-)

Dim CurFile As String
Dim NWB As Workbook, OWB As Workbook
Dim WS As Worksheet

'Change this line to indicate the folder
Const FileFolder = "C:\TestResults"

'Set active workbook as old workbook (OWB)
Set OWB = ActiveWorkbook

'Get name of first workbook in specified folder
CurFile = Dir(FileFolder & "\*.xls")

Do While CurFile <> ""
'Open "Dir()" workbook
Set NWB = Workbooks.Open(FileFolder & "\" & CurFile)

'Copy all sheets (excluding blanks)
For Each WS In NWB
If WS.Cells.SpecialCells(xlCellTypeLastCell).Value <> "" Then
WS.Copy after:=OWB.Worksheets(OWB.Worksheets.Count)
'Close workbook without saving changes
NWB.Close (False)
'Get next workbook
CurFile = Dir()
End If
Next WS
Loop
End Sub
Let me know how it goes :yes

parttime_guy
01-20-2006, 09:11 PM
Hi Guz

Yo! Malik - ur Sub CombineBooks_for_You(), I tried all crazy combinations but it just does not work :(

In Sub CombineBooks() , I changed the following line

NWB.Worksheets(1).Copy _
to
NWB.Worksheets().Copy _

It works! the problem of only copying the first sheet has been eliminated - now copies & pastes ALL sheets from ALL workbooks in a given path with their respective names - But I can't seem to make it skip blank worksheets - plz help me on this one.

Thx-n-BR

malik641
01-21-2006, 01:03 AM
Hi Guz

Yo! Malik - ur Sub CombineBooks_for_You(), I tried all crazy combinations but it just does not work :(

In Sub CombineBooks() , I changed the following line

NWB.Worksheets(1).Copy _
to
NWB.Worksheets().Copy _

It works! the problem of only copying the first sheet has been eliminated - now copies & pastes ALL sheets from ALL workbooks in a given path with their respective names - But I can't seem to make it skip blank worksheets - plz help me on this one.

Thx-n-BR
Interesting...what was happening? Does it contain an error? If so, what type?

The way I have it set up is so it skips blanks. It's identical to your code accept the copy piece. So let me know what went wrong with my code and what combinations you used and I'll see what I can do.

geekgirlau
01-21-2006, 03:33 PM
Guys, you might want to consider some error handling to cope with any sheets that have the same name.

lucas
01-21-2006, 04:14 PM
Try this:

Sub CombineFiles()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False
Path = "C:\TestResults\" 'Change as needed
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For Each WS In Wkb.Worksheets
If WS.Cells.SpecialCells(xlCellTypeLastCell).Value <> "" Then
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If
Next WS
Wkb.Close False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

malik641
01-21-2006, 05:13 PM
Thanks Steve...I knew I was missing something :yes

For each WS in NWB.Worksheets


:doh:Doh!

parttime_guy
01-21-2006, 07:31 PM
Yo! Guz-n-Galz

Gibbs, Malik, GeekGirl, Lucas (Steve) - Thx 4 all ur help. Ur inputs have helped me make my Weekly Office Reports (about 30+ workbooks) work like magic.

The final code pasted by Lucas - ROCKS

Happy Excelling :)

Yo! Everybody

lucas
01-22-2006, 09:15 AM
Glad it worked out....I just combined a kb entry by Jake with some of Joseph's code from above....Joseph came up with the code for dealing with the blank sheets

malik641
01-23-2006, 07:32 AM
Glad it worked out....I just combined a kb entry by Jake with some of Joseph's code from above....Joseph came up with the code for dealing with the blank sheetsYeah I thought that was a pretty nifty idea :)

parttime_guy
01-24-2006, 08:32 PM
Hi Everybody
Problems once again ? here we go!
The code copies data only till the row where data is there (assuming there is a blank row after the first 10 rows?. It copies only 10 rows and skips all data after 10 rows) - :bug:

Eg:
A B C D
1 Data Data Data Data
2 Data Data Data Data
3
4 Data Data Data Data
5 Data Data Data Data

The code copies only data from (A1 : D2) and skips the rest it should copy the whole sheet, irrespective where the data is.

The code skips blank sheets, but also skip the sheets in which data is there (assuming first two rows has a data header and second row is blank and then data follows, it skips the whole sheet) - :dunno

Eg:
A B C D
1 Data Data Data Data
2 Data Data Data
The code just skips sheets (if there is no data in B2) with above format.

Guz ? Iam in a FIX :banghead: plz :help

malik641
01-24-2006, 10:16 PM
Hey parttime_guy

Don't know what's wrong...it's working okay for me.....do you have more code than that??? If so, could you post it?

lucas
01-25-2006, 12:11 PM
Its working for me too....even if there is only data in cell A1, even if there are multiple blank rows, even if I merge cells......I'm with Joseph, you must have some other code interfering.

example file attached with sample files to test with. Change the path in the code for the "combine workbooks" book and put the example files in the path you used in the code.

parttime_guy
01-25-2006, 07:56 PM
Guz, I am confused :mkay - I have made changes to be path and included my test files - I have also made changes to the existing sample files but the code is not working - plz check the attachment and let me have ur views - : pray2:

:help Plz Help!
Well I cant do anything but this! :banghead:
Thx-n-BR

lucas
01-25-2006, 08:58 PM
Its opening each file, just not copying them per our request.......
We will have to change Joseph's code a little......let us look it over and get back with you...any ideas Joseph?

lucas
01-25-2006, 09:16 PM
I think I found the problem.....
this line selects the last cell in the used range:

If WS.Cells.SpecialCells(xlCellTypeLastCell).Value <> "" Then

by using xlCellTypeLastCell

problem is that in the file-a,b & c there is a blank cell in the lower right corner of the used range so Joseph's code ignores it. Now what can we do to fix it?

malik641
01-26-2006, 12:35 PM
Hey guys, okay check this out :thumb

Option Explicit

Sub CombineFiles()

Dim Path As String
Dim FileName As String
Dim LastCell As Range
Dim Wkb As Workbook
Dim WS As Worksheet
Dim ThisWB As String

ThisWB = ThisWorkbook.Name
Application.EnableEvents = False
Application.ScreenUpdating = False
Path = "C:\Documents and Settings\Joe\Desktop\New Folder" 'Change as needed
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
If FileName <> ThisWB Then
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For Each WS In Wkb.Worksheets
Set LastCell = WS.Cells.SpecialCells(xlCellTypeLastCell)
If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then
Else
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If
Next WS
Wkb.Close False
End If
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Took care of the File-a, File-b, etc... problem with a different IF statement.

I also noticed that if the workbook was in the same directory you would get a message saying the book is already open, so I made a work-around for that too :yes

Hope this works out :thumb

lucas
01-26-2006, 01:26 PM
That works for me Joseph....how about adding it to the kb? Be sure to credit Jake for his part.

malik641
01-26-2006, 01:28 PM
That works for me Joseph....how about adding it to the kb? Be sure to credit Jake for his part.
You know, that sounds like a good idea. Thanks Steve :thumb:thumb

parttime_guy
01-26-2006, 07:56 PM
Yo! Guz-n-Galz

Thx 4 all ur help&precious time. Ur inputs have helped me. I have tried and tested the code - it works like MAGIC

:bow: Apologies Malik! - UR code - ROCKS :friends:
Malik is the STAR


:beerchug: Yo! Everybody:thumb

malik641
01-27-2006, 10:35 AM
Yo! Guz-n-Galz

Thx 4 all ur help&precious time. Ur inputs have helped me. I have tried and tested the code - it works like MAGIC

:bow: Apologies Malik! - UR code - ROCKS :friends:
Malik is the STAR


:beerchug: Yo! Everybody:thumb
I am the MAN!!!! http://vbaexpress.com/forum/images/smilies/rotlaugh.gif

But I do give credit to Jake for the original code and Steve for helping me out http://vbaexpress.com/forum/images/smilies/023.gif Thanks guys!


And your welcome parttime_guy!!! Anytime http://vbaexpress.com/forum/images/smilies/045.gif

lucas
02-14-2006, 09:01 PM
Glad to be involved with you guys on this as it was somthing I was wanting too.