PDA

View Full Version : Naming sheets in "Combine All Workbooks from One Folder Skipping Blank Sheets"



Kriti
07-08-2010, 11:45 AM
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
07-08-2010, 12:52 PM
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.
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

Kriti
07-08-2010, 01:00 PM
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
07-08-2010, 01:54 PM
Oops, had a dupicate line.

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

Remove the & "-" & ws.Name and that will remove the sheet name.

Kriti
07-08-2010, 02:23 PM
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
07-08-2010, 02:32 PM
Just ran the code... I'm new to VBA if you couldn't tell. It's beautiful :P

Tinbendr
07-08-2010, 03:46 PM
OK, In Sub CombineFiles, after Application.ScreenUpdating = FalseAddDeleteAllSheetsButOne
then drop below the rest of the code and add 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

ksbcis
10-07-2011, 02:19 PM
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.
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


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!