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.
Related
I want the macro to backup my xlsm file as xlsx format, still remain there after save as xlsx type. However, below coding will convert the existing xlsm file to xlsx file, causing my macro file dissapear. Any suggestion to avoid this, I want xlsx file save and close while xlsm file remain?
Sub backup()
Application.DisplayAlerts = False
ThisWorkbook.saveas "C:\Users\Documents\Book1.xlsx", xlOpenXMLWorkbook
Application.DisplayAlerts = True
End Sub
Use SaveCopyAs.
Sub Test()
Dim wb As Workbook, wb2 As Workbook
Dim Path As String
Application.DisplayAlerts = False
Path = "C:\Users\" & Environ("Username") & "\Desktop\"
Set wb = ThisWorkbook
wb.SaveCopyAs (Path & "File.xlsm")
Set wb2 = Workbooks.Open(Path & "File.xlsm")
wb2.SaveAs Path & "File1.xlsx", xlOpenXMLWorkbook
wb2.Close
Application.DisplayAlerts = True
End Sub
This would save a copy to your desktop, but does not affect the Workbook you are working in.
ThisWorkbook addresses the workbook in which the code is located. If you wish to save the ActiveWorkbook you must address it either as ActiveWorkbook or by its name.
Once you save ThisWorkbook in xlsx format the code can't continue to run. To do what you intend to do you might place the code in a third file, like an add-in, and manipulate your workbooks from there.
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
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
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
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.