Combine Multiple Excel Workbooks into one Workbook with multiple sheets - vba

I have about 70 different excel files that I need to combine into one master workbook. I would like each excel file to get its own worksheet in the master workbook. The name of the worksheet generated in the master workbook doesn't matter.
I retrieved this code off of another website, but cannot make it work for my needs. This code stipulates that all files to be combined are located in the same directory. I have them located here "C:\Users\josiahh\Desktop\cf"
Below is the code as it is now
Sub GetSheets()
Path = "C:\Users\dt\Desktop\dt kte\"
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 is tested and works as expected. You would be wise to use Option Explicit and declare your variables appropriately in the future, although that did not cause any problems with your code.
As indicated in comments above, the likely failure is that the argument you're passing to the Dir function is unnecessarily restrictive:
=Dir(path & "*.xls") will look ONLY for files ending exactly in ".xls", and will not account for newer file formats. To resolve that, do =Dir(path & "*.xls*")
Code below:
Option Explicit
Const path As String = "C:\Users\dt\Desktop\dt kte\"
Sub GetSheets()
Dim FileName As String
Dim wb As Workbook
Dim sheet As Worksheet
FileName = Dir(path & "*.xls*")
Do While FileName <> ""
Set wb = Workbooks.Open(FileName:=path & FileName, ReadOnly:=True)
For Each sheet In wb.Sheets
sheet.Copy After:=ThisWorkbook.Sheets(1)
Next sheet
wb.Close
FileName = Dir()
Loop
End Sub

Related

Excel Dir returns unexpected null

I'm trying to write what I thought would be a simple routine to take all the Excel sheets in a directory and copy them to tabs in a master sheet. Here's what I'm trying:
Sub GetSheets()
myPath = "C:\Users\Brian.Scott\Documents\2017_INVENTORY\TestInv"
Filename = Dir(myPath)
MsgBox (Filename)
Do While Filename <> ""
Workbooks.Open Filename:=myPath & 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
I put in the MsgBox when nothing was happening. It returns a null. myPath returns the correct name - which I copied and pasted from explorer to avoid spelling errors. I only have excel files in the directory, so I'm not error checking. This is a one-off need, but there are over 200 files in the directory, so I figured I could spend a little time on the code.
Any ideas will be greatly appreciated as I'm pretty green with this.
Declare all your variables - specify Option Explicit at the top of every module, and then declare every single variable you use until the code compiles again. Not doing that is only asking for trouble; VBA will happily compile and run a typo, and debugging that isn't fun at all. Use Option Explicit. Always.
Option Explicit
Public Sub GetSheets()
Const myPath As String = "C:\Users\Brian.Scott\Documents\2017_INVENTORY\"
Const myFilter As String = "TestInv*.xls?"
Dim myFilename As String
myFilename = Dir(myPath & myFilter)
Do While myFilename <> vbNullString
MsgBox myFilename
With Workbooks.Open(Filename:=myPath & myFilename, ReadOnly:=True)
Dim sh As Worksheet
For Each sh In .Worksheets
sh.Copy After:=ThisWorkbook.Sheets(1)
Next
.Close
End With
Filename = Dir
Loop
End Sub
Notice that With block - it's holding a reference to the Workbook object that the Workbooks.Open function returns, so you can do .Worksheets and .Close against it, without needing to code against ActiveWorkbook, and without needing to re-fetch that exact same object reference from the Workbooks collection at every iteration.
Your myPath contains a path, yes, but also wildcards, and I doubt this would work as expected:
Workbooks.Open "C:\Users\Brian.Scott\Documents\2017_INVENTORY\TestInv*.xls?\TestInv42.xlsx"
That's why I split the myPath string into a path and a filter: you supply the filter to the Dir function, and supply the Workbooks.Open function with the path with the file name that Dir returned.

Merging multiple workbooks in to one workbook

I am looking to take multiple Excel workbooks (that each have 1 worksheet) and merge them in to one Workbook.
So currently I have 9 workbooks, each with 1 worksheet, I would like to end up with 1 workbook, with 9 worksheets.
This is the code I have been using:
Function MergeBooks(Path As String)
Set NewBook = Workbooks.Add
With NewBook
.Title = "Merged Data"
.Subject = "End User Data"
.SaveAs Filename:=Path & "mergedFinal.xlsx", FileFormat:=xlOpenXMLWorkbook
End With
Filename = Dir(Path & "*.xlsx")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=NewBook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
NewBook.Save
End Function
In my mind it seems to follow the right steps, I plan to run this from PowerShell and so far it runs and makes the new file, and I can see it loop through the files in the folder, so these are being picked up fine. However, when going to copy the worksheet on line 15 it produces an error "out of memory". The final product workbook then ends up empty.
Any advice would be appreciated. Thanks

Use Paste special in excel macro while copying multiple workbooks in one master workbook

I am trying to use a macro to copy multiple workbooks into one integrated workbook. I am able to do it; however I am not finding a way to use paste special to kee the formatting of source worksheets intact. I would really appreciate if someone could please help/guide
here is the code:
Sub GetSheets()
Path = "C:\Users\ssehgal\Documents\Excel-Files-For-Macro\"
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

Copy merge specific worksheets to one workbook

I am trying to copy a worksheet called "application" from all identical files in a folder, into a master workbook and rename the copied worksheet in the name of the file its been copied from. So far my code copies everything and I cannot get it to rename the copied worksheet to name of file it came from.
Thank you
Sub GetSheets()
Application.ScreenUpdating = False
Path = "C:\Users\Desktop\Work docs\"
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
If Sheet.Name = "application" Then
End If
Sheets.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close SaveChanges:=False
Filename = Dir()
Loop
Application.ScreenUpdating = True
End Sub
Your IF condition is closing before you are copying 'application' sheet, so Sheets.Copy will just copy all the sheets from your workbook. You can try the below code:
Do While Filename <> ""
Workbooks.Open Filename:=Path1 & Filename, ReadOnly:=True
For Each Sheet In Workbooks(Filename).Sheets
If Sheet.Name = "application" Then
Sheet.Copy After:=ThisWorkbook.Sheets(1)
ThisWorkbook.Sheets("application").Name = Filename & "-application" 'Changes the sheetname from "application" of test1.xls workbook to "test1.xls-application"
End If
Next Sheet
Workbooks(Filename).Close SaveChanges:=False
Filename = Dir()
Loop
I was not able to use Path as a variable (maybe due to some system configuration - need to check why), so I have used Path1 instead. You can use ActiveWorkbook.Sheets also instead of Workbooks(Filename).Sheets. However I feel its better to reference a workbook by its name.

Excel macro to combine workbooks, Runtime Error 1004

I am attempting to merge specific xls files into one sheet, but I get a runtime error 1004 saying " Copy method of Worksheet class failed" I am thinking this is because I am trying to merge over 100 files?
Sub GetSheets()
Path = "C:\Users\..."
Filename = Dir(Path & "*100.00mA.isd.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
I have occssionally run into a "timing" problem with xl2003 and ActiveWorkbook, maybe this is causing your problem. Sometimes the VBA code gets to the ActiveWorkbook line before Excel has the new workbook fully opened, consequently, ThisWorkbook becomes the ActiveWorkbook. The way to work around this is to specifically assign a variable to the new workbook.
Sub GetSheets()
Dim wB As Workbook '<=New
Path = "C:\Users\..."
Filename = Dir(Path & "*100.00mA.isd.xls")
Do While Filename <> ""
Set wB = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True) '<=New
For Each Sheet In wB.Sheets '<=New
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
wB.Close '<=New
Filename = Dir()
Loop
End Sub
There is another situation, where the described runtime error will appear:
In the case that your target workbook is an Excel 97-2003 file (.xls) and your source workbook is an Excel 2007 (or higher) file (.xlsx).
Having this combination, the sheet.copy method will cause the same runtime error.
You may check the different workbook formats by reading the ActiveWorkbook.FileFormat property.