combine several workbooks without opening

[Trang]

I have 100++ workbooks saved in the same folder. Each workbook has only 1
sheet. How can I combine all of them together into one big workbook without
opening each file and copy and paste? In that big workbook I just need to put
data from each small workbook one after another, no matter they are of the
same format or not.
Each small workbook has some merged cells, but in the new big workbook,
those cells should be unmerged.
Is there a fast way to accomplish this task?
Thank you!

 

[Ron de Bruin]

Hi Trang

Try this add-in
http://www.rondebruin.nl/merge.htm

Or use the code in the links on the bottom of that page

Maybe ADO is another option for you but try the add-in first
http://www.rondebruin.nl/ado.htm

 

[Trang]

Big thanks, Ron. It worked like a charm!

Hi Trang

Try this add-in
http://www.rondebruin.nl/merge.htm

Or use the code in the links on the bottom of that page

Maybe ADO is another option for you but try the add-in first
http://www.rondebruin.nl/ado.htm

 

[Steve]

I loaded the addin. It worked but I got all of the results on one sheet.
I'd like to merge several books but keep the separate sheets. For example,
if workbook a has sheets s1, s2, s3 and workbook b has sheets s4, s5, I want
a new workbook with s1, s2, s3, s4, s5.

 

[Ron de Bruin]

Hi Steve

I have a code example for 1 sheet from each workbook here
http://www.rondebruin.nl/fso.htm

But try this tester

Sub Test_1()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim Fnum As Long
Dim mybook As Workbook, BaseWks As Worksheet
Dim CalcMode As Long

'Fill in the path\folder where the files are
MyPath = "C:\Users\Ron\test"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

'Add a new workbook with one sheet
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
BaseWks.Name = "wertyu"

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
On Error GoTo 0

If Not mybook Is Nothing Then

On Error Resume Next

mybook.Worksheets.Copy _
after:=BaseWks.Parent.Sheets(BaseWks.Parent.Sheets.Count)

End If
mybook.Close savechanges:=False

Next Fnum
Application.DisplayAlerts = False
BaseWks.Delete
Application.DisplayAlerts = True
End If

'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub