Sometimes we may want to retrieve names of all worksheets in
a workbook, and this is not hard if we use Excel VAB. What if there are a lot
of workbooks? For example, is it possible for us to get names of all worksheets
from all those workbooks within one folder? It’s not difficult. We can get this
task done in two steps. First of all, try to get names of workbooks in a
folder. Secondly, loop through workbooks one by one to get names of all worksheets.
Get filename of all workbooks within a folder
First of all, we can design a worksheet like that in figure
1. The first cell in column A is used to contain the path of folder from which
we’d like to extract worksheet names. Two buttons – Get File Name and Get Tab
Name– were inserted in this worksheet. After clicking on the first button,
Excel can extract full pathnames of all workbooks within the specific folder (D:\sample
in our example) in column B one by one, just like what are displayed in the
bottom panel of figure 1.
Here is the macro assigned to the first button – Get File
Name. First of all, Excel will clear all
cells of column B except for the first cell. Then create an instance of file
system object and an instance of folder object. Finally, apply for loop to
extract names of workbooks one by one.
|
Sub Getfilename()
Application.ScreenUpdating =
False
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
lastrow =
ThisWorkbook.Worksheets(1).Cells(Rows.Count, "B").End(xlUp).Row
'Clear content
For j = 2 To lastrow
Cells(j + 1, 2) = ""
Next j
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
inpath = Trim(ThisWorkbook.Worksheets(1).Cells(2, 1))
Set objFolder = objFSO.GetFolder(inpath)
i = 1
'loops through each file in the directory and prints their names and
path
For Each objFile In objFolder.Files
temp = Split(objFile.Name,
".")
If (temp(UBound(temp)) =
"xls" Or temp(UBound(temp)) = "xlsx") And temp(0)
<> "Get Tab Name" Then
'print file name
ThisWorkbook.Worksheets(1).Cells(i + 1, 2) = inpath &
"\" & objFile.Name
i = i + 1
End If
Next objFile
End Sub
|
Loop through workbooks to get names of all worksheets
With names of all workbooks, we can click on the second
button to call another macro – tabname – to get names of all worksheets and put
the names in the tab ‘Output Tab Name’. By
clicking on the second button, we can get ‘Output Tab Name’ populated as below.
You can see that 2016_3066_FIE.xlsx contains one worksheet.
708A_STUDY_2016-12-15-05-19-20.xlsx consists of three worksheets and the names
of these three worksheets are “Sheet1”, “Sheet2” and “Sheet3”, respectively.
Here is the full code of tabname macro. There are two for
loops in total. The first one is to loop through all workbooks (cells in column
B) shown in figure 1. The second one is to loop through all worksheets within
one workbook. This second for loop is
nested within the first one.
|
Sub tabname()
Application.ScreenUpdating
= False
Application.DisplayAlerts =
False
'Define variable and object
Dim wbk As Workbook
n =
ThisWorkbook.Worksheets(1).Range("B" & Rows.Count).End(xlUp).Row
ThisWorkbook.Worksheets(2).UsedRange.Clear
For i = 2 To n
'Open file
ThisWorkbook.Worksheets(2).Cells(1, 1) = "File Name"
ThisWorkbook.Worksheets(2).Cells(1, 1).Font.Bold = True
ThisWorkbook.Worksheets(2).Cells(1,
1).Interior.Color = RGB(197, 217, 241)
Set wbk =
Workbooks.Open(ThisWorkbook.Worksheets(1).Cells(i, 2))
ThisWorkbook.Worksheets(2).Cells(i, 1) =
Split(ThisWorkbook.Worksheets(1).Cells(i, 2), "\")(UBound(Split(ThisWorkbook.Worksheets(1).Cells(i,
2), "\")))
For j = 1 To
wbk.Worksheets.Count
ThisWorkbook.Worksheets(2).Cells(1,
j + 1) = "Sheet Name" & j
ThisWorkbook.Worksheets(2).Cells(1, j + 1).Interior.Color = RGB(197,
217, 241)
ThisWorkbook.Worksheets(2).Cells(1, j + 1).Font.Bold = True
ThisWorkbook.Worksheets(2).Cells(i, j + 1) = wbk.Worksheets(j).Name
Next j
'Close both Excel files
and save changes
wbk.Close
SaveChanges:=False
Next i
'Part3 – Save
ThisWorkbook.Worksheets(2).Copy
With ActiveWorkbook
.SaveAs
Filename:=ThisWorkbook.Worksheets(1).Cells(2, 1) & "\Get Tab
Name.xlsx", FileFormat:=xlOpenXMLWorkbook
.Close
SaveChanges:=False
End With
ThisWorkbook.Save
End Sub
|
