Copy merge specific worksheets to one workbook - vba

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.

Related

Copy paste Excel Supported files from same folder into single excel

I have 2 different type of files. 1 is ".tsv" 2 is ".xlsx".
I want my macro (.xlsm) file to be in same folder where 2 different files (.tsv and .xlsx) are placed. I usually download them from some tools and normally they are placed in my default "Download" folder.
Problem 1: I want my macro file to read both format and copy paste data into single excel file. I am done with this problem. Code optimization is required.
Problem 2: I am currently assigning manual path to that folder and want macro to pick that folder path so that it can copy 2 extension files and proceed.
(Tried : ActiveWorkbook.Path, didn't work).
Dim FPath As String, filename As String, FileExt1 As String, FileExt2 As
String
Sub GetSheets()
FPath = "C:\Users\dinekuma\Desktop\Dinesh KT\Macro New UI\"
FileExt1 = "*.tsv"
FileExt2 = "*.xlsx"
'ActiveWorkbook.Path
'"C:\Users\dinekuma\Desktop\Dinesh KT\Macro New UI\"
filename = Dir(FPath & FileExt1)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While filename <> ""
Workbooks.Open filename:=FPath & filename, ReadOnly:=True
For Each sheet In ActiveWorkbook.Sheets
sheet.Copy After:=ThisWorkbook.Sheets(1)
ActiveSheet.Name = Split(filename, ".")(0)
Next sheet
Workbooks(filename).Close
filename = Dir()
Loop
filename = Dir(FPath & FileExt2)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While filename <> ""
Workbooks.Open filename:=FPath & filename, ReadOnly:=True
For Each sheet In ActiveWorkbook.Sheets
sheet.Copy After:=ThisWorkbook.Sheets(1)
ActiveSheet.Name = Split(filename, ".")(0)
Next sheet
Workbooks(filename).Close
filename = Dir()
Loop
MsgBox ("Import Successful!")
End Sub
Help in code optimization and automatic path pick by active macro file.

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

Combine Multiple Excel Workbooks into one Workbook with multiple sheets

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

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.