abhishekdevane
New Member
- Joined
- Feb 17, 2022
- Messages
- 1
- Office Version
- 2019
- Platform
- Windows
I am working on project where i need to add multiple workbooks Sheet in to master excel file.
For E.g
1.First Workbook name "Stats_CK"
2.Second Workbook name "Stats_AM".
Output Should be : Master Excel File with Sheets like Stats_CK and second Tab Stats_AM.
However i am getting an output reverse i.e. First tab Stats_AM and Stats_CK
I want macro should pick first workbook and paste in to Masterexcel first Tab
Code
Sub Conslidateworkbooks()
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = "H:\Desktop\Stats Report\"
Filename = Dir(FolderPath & "*.csv*")
Workbooks.Add
Set NewFile = ActiveWorkbook
MsgBox FolderPath
Dim i As Integer
i = 0
Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=NewFile.Sheets(i + 1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
i = i + 1
Loop
Application.ScreenUpdating = True
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete
ActiveWorkbook.SaveAs Filename:="file"
End Sub
For E.g
1.First Workbook name "Stats_CK"
2.Second Workbook name "Stats_AM".
Output Should be : Master Excel File with Sheets like Stats_CK and second Tab Stats_AM.
However i am getting an output reverse i.e. First tab Stats_AM and Stats_CK
I want macro should pick first workbook and paste in to Masterexcel first Tab
Code
Sub Conslidateworkbooks()
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = "H:\Desktop\Stats Report\"
Filename = Dir(FolderPath & "*.csv*")
Workbooks.Add
Set NewFile = ActiveWorkbook
MsgBox FolderPath
Dim i As Integer
i = 0
Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=NewFile.Sheets(i + 1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
i = i + 1
Loop
Application.ScreenUpdating = True
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete
ActiveWorkbook.SaveAs Filename:="file"
End Sub