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
Related
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
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
Sub MergeWorkbooks()
Dim Path As String
Dim FileName As String
Dim ws As Worksheet
Dim wb As Workbook
Application.EnableEvents = False
Application.ScreenUpdating = False
Path = "C:\Users\Name\Documents\Data\"
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
Set wb = Workbooks.Open(FileName:=Path & "\" & FileName)
For Each ws In wb.Worksheets
ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.count)
Next ws
wb.Close False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I have 2 workbooks in same directory. Workbook 1 contain sheet A only and Workbook 2 contains sheets B and C. How can I merge sheet A and sheet C to my current workbook?
Make sure you open your source workbooks and then use the Worksheet.Move method or the Worksheet.Copy method to move or copy them into your current workbook.
Dim SourceWb1 As Workbook
Set SourceWb1 = Workbooks.Open(FileName:="C:\Path\To\Your\workbook1.xls")
SourceWb1.Worksheets("Sheet A").Move After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
Dim SourceWb2 As Workbook
Set SourceWb2 = Workbooks.Open(FileName:="C:\Path\To\Your\workbook2.xls")
SourceWb2.Worksheets("Sheet C").Move After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
If you used the .Move method make sure you don't forget to save your source workbooks:
SourceWb1.Close SaveChanges:=True
SourceWb2.Close SaveChanges:=True
If you used the .Copy method close them without saving:
SourceWb1.Close SaveChanges:=False
SourceWb2.Close SaveChanges:=False
As the title suggests, this code fails on the line Sheet.Copy After:=ThisWorkbook.Sheets(1) with runtime error 1004
Why would this run when added as a module but not when saved as an add-in?
Here's the code:
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = GetFolder() & "\"
Filename = Dir(FolderPath & "*.xls*")
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
As #BruceWayne suggested is a problem with deciding the correct workbook. As an AddIn, ThisWorkbook will be the AddIn workbook, while ActiveWorkbook (before opening others), will be the workbook you are running your AddIn into.
Simply replacing Thisworkbook with ActiveWorkbook in your scenario won't work, because you would just copy the sheets from the newly open workbook, to the same.
Is a good idea to declare variables to hold this informations, then you can open as many workbooks as you want, and from where you want.
See below:
Application.ScreenUpdating = False
Dim wbDst As Workbook: Set wbDst = ActiveWorkbook 'Can also use Worbooks("book name here")
Dim wbSrc As Workbook
Dim Sht As Worksheet
Dim FolderPath As String: FolderPath = GetFolder() & "\"
Dim FileName As String: FileName = Dir(FolderPath & "*.xls*")
Do While FileName <> ""
Set wbSrc = Workbooks.Open(FileName:=FolderPath & FileName, ReadOnly:=True)
For Each Sht In wbSrc.Worksheets
Sht.Copy After:=wbDst.Sheets(1)
Next Sht
wbSrc.Close
FileName = Dir()
Loop
Application.ScreenUpdating = True
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