Naming sheets in "Combine All Workbooks from One Folder Skipping Blank Sheets"

[Kriti]

This question is about malik641 's macro called "Combine All Workbooks from One Folder Skipping Blank Sheets". Is there a way to name each sheet as it is getting imported?

For example, if I import "Sheet1" from Test.xls, is there a way that the imported worksheet will be named "Test" rather than "Sheet1"?

Thank you!

[Tinbendr]

Replace the sub with this one.

This creates a "WorkBook name-Sheet Name" sheet name, because if you have more than one sheet, it will fail using only the source workbook name.
[vba]Sub CombineFiles()
Dim path As String
Dim FileName As String
Dim LastCell As Range
Dim Wkb As Workbook
Dim ws As Worksheet
Dim ThisWB As String
Dim ShtName As String
Dim ExtPos As Long
ThisWB = ThisWorkbook.Name
Application.EnableEvents = False
Application.ScreenUpdating = False
path = GetDirectory
FileName = Dir(path & "\*.xls", vbNormal)
Do Until FileName = ""
If FileName <> ThisWB Then
Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
For Each ws In Wkb.Worksheets
Set LastCell = ws.Cells.SpecialCells(xlCellTypeLastCell)
If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then
Else
ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'Locate the last period in filename by reversing the string.
ExtPos = InStr(StrReverse(Wkb.Name), ".")
'Strip the extension. Accounts for any length extension.
ShtName = Mid(Wkb.Name, 1, Len(Wkb.Name) - ExtPos) & "-" & ws.Name
'Rename the new sheet to Imported WB and Sheet names
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = ShtName
End If
Next ws
Wkb.Close False
End If
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True

Set Wkb = Nothing
Set LastCell = Nothing
End Sub[/vba]

[Kriti]

Thank you Tinbendr! That was so fast!

One more thing - how would I alter the code so it is just the workbook (and not worksheet) name? All the workbooks are STATA outputs, so they cannot have more than one worksheet. Good thought though.

[Tinbendr]

Oops, had a dupicate line.

Remove
[vba]ShtName = Left(Wkb.Name, Len(Wkb.Name) - 5) & "-" & ws.Name[/vba]
It is the same line as above only different.

Remove the [VBA] & "-" & ws.Name[/VBA] and that will remove the sheet name.

[Kriti]

Hi again - thanks a million for all your help. There's one last thing, I promise! Is there a way to delete all the imported sheets before if you re-import?

[Kriti]

Just ran the code... I'm new to VBA if you couldn't tell. It's beautiful :P

[Tinbendr]

OK, In Sub CombineFiles, after [vba]Application.ScreenUpdating = False[/vba]Add[vba]DeleteAllSheetsButOne[/vba]
then drop below the rest of the code and add [vba]Sub DeleteAllSheetsButOne()
Dim WrkSht As Worksheet
Application.DisplayAlerts = False
With ActiveWorkbook
For Each WrkSht In .Worksheets
If WrkSht.Name <> "Sheet1" And .Worksheets.Count > 1 Then
WrkSht.Delete
End If
Next
End With
Application.DisplayAlerts = True
End Sub
[/vba]

[ksbcis]

Replace the sub with this one.

This creates a "WorkBook name-Sheet Name" sheet name, because if you have more than one sheet, it will fail using only the source workbook name.
[vba]Sub CombineFiles()
Dim path As String
Dim FileName As String
Dim LastCell As Range
Dim Wkb As Workbook
Dim ws As Worksheet
Dim ThisWB As String
Dim ShtName As String
Dim ExtPos As Long
ThisWB = ThisWorkbook.Name
Application.EnableEvents = False
Application.ScreenUpdating = False
path = GetDirectory
FileName = Dir(path & "\*.xls", vbNormal)
Do Until FileName = ""
If FileName <> ThisWB Then
Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
For Each ws In Wkb.Worksheets
Set LastCell = ws.Cells.SpecialCells(xlCellTypeLastCell)
If LastCell.Value = "" And LastCell.Address = Range("$A$1").Address Then
Else
ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'Locate the last period in filename by reversing the string.
ExtPos = InStr(StrReverse(Wkb.Name), ".")
'Strip the extension. Accounts for any length extension.
ShtName = Mid(Wkb.Name, 1, Len(Wkb.Name) - ExtPos) & "-" & ws.Name
'Rename the new sheet to Imported WB and Sheet names
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = ShtName
End If
Next ws
Wkb.Close False
End If
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True

Set Wkb = Nothing
Set LastCell = Nothing
End Sub[/vba]

I ran this code and I get the following:
Hey there tinbendr!

I ran your code and got the following error message:

Run-time error '1004':

You typed an invalid anem for a sheet or chart. Make sure that:

* The name that you type does not exceed 31 characters.

* The name does not contain any of the following characters: : \ / ? * [ or ]

*You did not leave the name blank


The when I attempt to debug, it references this line

ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = ShtName


Any idea as to what I should look for?

Thanks!