Currently able to copy all sheets from multiple excel files into one excel using the below code. However, I want to copy all data only from specific sheets (name defined) from multiple excel sheets.
need help!
Current Macro Code:
Sub ConslidateWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
Path = "E:\Excel_Projects\mergertest\"
Filename = Dir(Path & "*missing *")
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
Here is one approach you can try. Copy all sheets to your workbook, then delete the unwanted sheets.
Sub ConslidateWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
Path = "E:\Excel_Projects\mergertest\"
Filename = Dir(Path & "*missing *")
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
'One approach is to delete the unwanted sheets, once everything is copied to this workbook.
Dim UnWantedSheets As New Collection
UnWantedSheets.Add "Sheet4" 'Add all unwanted sheet names to this collection
UnWantedSheets.Add "Sheet5"
UnWantedSheets.Add "Sheet1"
Dim thissht As Worksheet
For Each thissht In ThisWorkbook.Sheets
For Each sht In UnWantedSheets
If LCase(thissht.Name) = LCase(sht) Then
Application.DisplayAlerts = False
thissht.Delete
Application.DisplayAlerts = True
Exit For
End If
Next
Next
End Sub
Related
This Macro I have continues to merge the files from my folder into the current open workbook. I am trying to open a new workbook and have it merge into the new open workbook. I am not sure where I need to activate the newly opened/ added workbook in order for the merge to take place in that file.
Sub MergeWorkbooks()
Application.DisplayAlerts = False
Workbooks.Add
ActiveWorkbook.SaveAs FileName:="C:\ ....\Merged Files.xlsx"
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = "<Folder destination>"
Filename = Dir(FolderPath & "*.xls*")
workbooks("Merged Files.xlsx").Activate
Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.ScreenUpdating = True
End Sub
Since Workbooks.Add and Workbooks.Open return a reference to the newly added or opened workbook, use two Workbook variables:
Dim mergedWb As Workbook
Set mergedWb = Workbooks.Add()
mergedWb.SaveAs FileName:="C:\ ....\Merged Files.xlsx"
...
Do While Filename <> ""
Dim wb As Workbook
Set wb = Workbooks.Open(Filename:=FolderPath & Filename, ReadOnly:=True)
For Each Sheet In wb.Sheets
Sheet.Copy After:=mergedWb.Sheets(1)
Next Sheet
wb.Close
Filename = Dir()
Loop
I am trying to use VBA in order to automate a boring work process. I don't know the language so I copied a code from the internet which is as follows:
Problem statement: I have multiple excel files in one folder, from
them I have to extract a single sheet named "sheet 1" (all the files
have it, but sheet1 isn't the only sheet those workbooks have).
Then I have to paste them in a new workbook. (I don't mind
if each of them are in different sheet, because I'll just record a
macro to compile them later on)**
Does anyone have any suggestions?
Sub Combine_files()
Dim Path As String
Dim Filename As String
Dim Sheet As Worksheet
Path = "C:\Users\prayag.purohit\OneDrive\Desktop\Project KC\New folder\"
Filename = Dir(Path & "*.xlsx")
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
Below code takes the first sheet in every file and names the sheet to the filename.
Option Explicit
Sub Combine_files()
Dim Path As String, Filename As String
Dim wbFile As Workbook, wbActive As Workbook
Set wbActive = ActiveWorkbook
Path = "C:\Users\prayag.purohit\OneDrive\Desktop\Project KC\New folder\"
Filename = Dir(Path & "*.xlsx")
With Application
.ScreenUpdating = False
End With
Do While Filename <> ""
Set wbFile = Workbooks.Open(Path & Filename, False, True)
wbFile.Sheets(1).Copy After:=wbActive.Sheets(1)
wbActive.Sheets(2).Name = Filename
wbFile.Close SaveChanges:=False
Filename = Dir()
Loop
wbActive.Sheets(1).Select
With Application
.ScreenUpdating = True
End With
End Sub
I would like to get the sheetname after I imported it excel workbook.
Below I was able to get the file name and now I would like to get the sheetname from the excel files imported and place in cell "C2"
Sub GetSheets()
'Update Excel Junction.com
Path = "C:\Users\momo\Desktop\Miscellaneous Shipment Packing List\New folder\"
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)
Range("B2").Value = Filename
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub
Simply by adding two lines into your loop, you can add the sheetnames:
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
k = 1
For Each Sheet In ActiveWorkbook.Sheets
Cells(2, 2+k).Value = Sheet.Name
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Range("B2").Value = Filename
k = k + 1
Next Sheet
In this example, if your workbooks have several sheets, the sheets will be added in the cells C D E F etc...
Try,
option explicit
Sub GetSheets()
dim wb1 as workbook, sh as worksheet
dim filename as string, path as string
set wb1 = thisworkbook
Path = "C:\Users\momo\Desktop\Miscellaneous Shipment Packing List\New folder\"
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
with Workbooks.Open( Filename:=Path & Filename, ReadOnly:=True)
For Each sh In .workSheets
sh.Copy After:=wb1.workSheets(1)
wb1.worksheets(1).cells(rows.count, "B").end(xlup).offset(1,0) = Filename
wb1.worksheets(1).cells(rows.count, "B").end(xlup).offset(0,1) = sh.name
Next sh
.Close savechanges:=false
end with
Filename = Dir()
Loop
End Sub
The rows.count doesn't require a parent because wb1 is either an xls or xlsx and you are opening xls's (unless you are opening more than 65K workbooks).
I need to create a macro that merges a list of excel files in a directory.
The folder contains other files that I don't want to pick. So, I need to specify the list of files (such as, selecting all the files which name contains "02.08.xlsx").
This is my first time using VBA, so please take that into consideration.
I've tried some things, but I think I always get problems regarding the files selection.
Here's what I've tried so far, but not working:
Sub MergeWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim ListFilenames As Variant
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = CurDir()
ListFilenames = Array("*02.08.02.01*.xlsx", "*02.08.13.01*.xlsx")
For i = 1 To 2
Filename = Dir(FolderPath & ListFilenames(i))
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Next i
Application.ScreenUpdating = True
End Sub
The code is wouldb be like this.
Sub MergeWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim ListFilenames As Variant
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = CurDir()
ListFilenames = Array("*02.08.02.01*.xlsx", "*02.08.13.01*.xlsx")
For i = 0 To 1
Filename = Dir(FolderPath & "\" & ListFilenames(i))
Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & "\" & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Next i
Application.ScreenUpdating = True
End Sub
Use the AddIn from the link below.
https://www.rondebruin.nl/win/addins/rdbmerge.htm
That will do what you want.
I want to Copy all sheets of multiple workbooks within a folder into another single workbook. I found below code but do not know how to paste special only values to avoid unnecessary formatting.
Sub GetSheets()
Path = "C:\Users\mechee69\Download\"
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
Try the code below, it will PasteSpecial only the Values, if you want you can extend to copy also the Formats.
Option Explicit
Sub GetSheets()
Dim Path As String, Filename As String
Dim WB As Workbook
Dim Sht As Worksheet, ShtDest As Worksheet
Path = "C:\Users\mechee69\Download\"
Filename = Dir(Path & "*.xls*")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While Filename <> ""
Set WB = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
For Each Sht In WB.Sheets
Set ShtDest = ThisWorkbook.Sheets.Add(After:=Sheets(1))
Sht.Cells.Copy
ShtDest.Name = Sht.Name '<-- might raise an error in case there are 2 sheets with the same name
ShtDest.Cells.PasteSpecial xlValues
Next Sht
WB.Close
Filename = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub