ShoaibAli
Banned - Rules violations
- Joined
- Jan 15, 2020
- Messages
- 121
- Office Version
- 365
- 2019
- 2016
- 2013
- 2011
- 2010
- 2007
- Platform
- Windows
Dear Team,
Using below but i dont want to add sheet name with xlxs. please correct the code so just it only paste the WB name as just 201710 201711 201712
Please update the code.
</>
Sub mergeWorkbooks()
Dim files, fn, wb As Workbook
files = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , "Select Files", "Merge", True)
If TypeName(files) = "Boolean" Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb = Workbooks.Add
While wb.Sheets.Count > 1
wb.Sheets(wb.Sheets.Count).Delete
Wend
For Each fn In files
If fn <> ThisWorkbook.FullName Then
With Workbooks.Open(fn)
.Sheets(1).Copy After:=wb.Sheets(wb.Sheets.Count)
If you want to rename the new sheet to be the filename of the sheet it came from uncomment the line below
wb.Sheets(wb.Sheets.Count).Name = .Name
.Close False
End With
End If
Next fn
wb.Sheets(1).Delete
wb.Activate
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Done!", vbInformation
End Sub
</>
Using below but i dont want to add sheet name with xlxs. please correct the code so just it only paste the WB name as just 201710 201711 201712
Please update the code.
</>
Sub mergeWorkbooks()
Dim files, fn, wb As Workbook
files = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", , "Select Files", "Merge", True)
If TypeName(files) = "Boolean" Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wb = Workbooks.Add
While wb.Sheets.Count > 1
wb.Sheets(wb.Sheets.Count).Delete
Wend
For Each fn In files
If fn <> ThisWorkbook.FullName Then
With Workbooks.Open(fn)
.Sheets(1).Copy After:=wb.Sheets(wb.Sheets.Count)
If you want to rename the new sheet to be the filename of the sheet it came from uncomment the line below
wb.Sheets(wb.Sheets.Count).Name = .Name
.Close False
End With
End If
Next fn
wb.Sheets(1).Delete
wb.Activate
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Done!", vbInformation
End Sub
</>