Code Correction Required

[ShoaibAli]

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
</>

 

[DanteAmor]

Change this line:

wb.Sheets(wb.Sheets.Count).Name = .Name

For this:

wb.Sheets(wb.Sheets.Count).Name = Left(.Name, Len(.Name) - 5)

 

[Fluff]

How about

wb.Sheets(wb.Sheets.Count).Name = split(.Name,".")(0)

 

[DanteAmor]

If you have a name with intermediate dots and a 3 character extension example:
invoice.2020.xls
Then

wb.Sheets(wb.Sheets.Count).Name = Left(.Name, InStrRev(.Name, ".") - 1)

 

[ShoaibAli]

If you have a name with intermediate dots and a 3 character extension example:
invoice.2020.xls
Then

wb.Sheets(wb.Sheets.Count).Name = Left(.Name, InStrRev(.Name, ".") - 1)

Sir thank you so much.

 

[DanteAmor]

Glad we could help & thanks for the feedback