Get names of all worksheets from all workbooks within one folder using VBA

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

 

How to create and format a workbook by VBA

Today I’d like to share with you some basic skills on manipulating Excel by VBA.

Create/Close/Delete a workbook

The best way of creating a new workbook is to use Add method to assign it to an object variable. Below is the full program and explanations demonstrating how to create the new workbook – ws.xls - and save it under E:\Example. Then the program also shows how to delete a workbook. Please note that workbook must be closed before it can be removed.

Sub Create_workbook() 'Create an object variable Dim wbk As Workbook 'Assign Workbook object to wkb Set wbk = Workbooks.Add 'Save fullname as a string variable wbkName = "E:\Example\Ws.xls" 'Save workbook with above fullname wbk.SaveAs wbkName 'Close the workbook wbk.Close 'Delete the workbook Kill wbkName End Sub

Return range reference (Address)

By Using Range.Address method, we can return a string value that represents range reference. Together with Mid function, we can even return column name. This is a very important skill which will be demonstrated in next part.

Sub Return_Address() '$A$1 MsgBox Worksheets(1).Cells(1, 1).Address 'Another way to return $A$1 Set mc = Worksheets(1).Cells(1, 1) MsgBox mc.Address '$A$1:$E$5 addr = Worksheets(1).Cells(1, 1).Address & ":" & Worksheets(1).Cells(5, 5).Address MsgBox addr 'Get Column Name For i = 6 To 9    addr = Cells(1, i).Address    colName = Mid(addr, 2, 1)    MsgBox colName Next i End Sub

Change RowHeight/ColumnWidth

Occasionally, length of values that we entered or pasted into cells is more than width. In this case, we need to adjust column width in order to see entire data. And sometimes, the data is too lengthy that we have to wrap it and change row height to see whole data. Following presents how to adjust Row Height or Column Width.

Sub Change_RowHeight() 'Changing the 4th row Height Rows(4).RowHeight = 30 'Changing height for multiple rows Rows("5:9").RowHeight = 2 'Another way to change height for multiple rows For i = 7 To 8  Rows(i).RowHeight = 10 Next i End Sub

Sub Change_ColumnWidth() 'Changing the 2nd column width Columns("B").ColumnWidth = 20 'Changing width for multiple columns Columns("C:E").ColumnWidth = 5 'Another way to change column width for multiple columns For i = 6 To 9   'Get Column Name    addr = Cells(1, i).Address    colName = Mid(addr, 2, 1)    If i = 6 Then       temp = colName    Else       temp = temp & "-" & colName    End If Next i faddr = Split(temp, "-")(0) & ":" & Split(temp, "-")(UBound(Split(temp, "-"))) Columns(faddr).ColumnWidth = 30 End Sub

Change Backgroundcolor

RGB(255,0,0) is for red, RGB(0,225,0) is for Green and RGB(0,0,255) is for blue.

Sub Change_Backgroundcolor() 'Example 1 Cells(1, 1).Interior.Color = RGB(255, 0, 0) Range("A2").Interior.Color = RGB(0, 0, 255) 'Example 2 For i = 4 To 9   If i Mod 2 <> 0 Then     For j = 1 To 9       Cells(i, j).Interior.Color = RGB(0, 225, 0)     Next j   End If Next i 'Example 3 - anther more efficient way to reset multiple cells For i = 4 To 9   If i Mod 2 = 0 Then      addr = Cells(i, 1).Address & ":" & Cells(i, 9).Address      Range(addr).Interior.Color = RGB(255, 0, 0)   End If Next i ‘Clear backgroundcolor Cells(1, 1).Interior.Color = xlnone End Sub

Modify font format(font style, bold, italicize, underline, color, size)

Sub Change_Font() 'Change font style Range("A1").Font.FontStyle = "Bold Italic" Cells(2, 1).Font.FontStyle = "Times New Roman" 'Change font to bold Range("A1").Font.Bold = True Cells(2, 1).Font.Bold = True 'Change font to Italic Range("A1").Font.Italic = True Cells(2, 1).Font.Italic = True 'Underline text Range("A1").Font.Underline = True Cells(2, 1).Font.Underline = True 'Change font color Range("A1").Font.Color = RGB(255, 0, 0) Cells(2, 1).Font.Color = RGB(0, 0, 255) 'Change font size Range("A1").Font.Size = 14 Cells(2, 1).Font.Size = 28 'Example For i = 4 To 9   If i Mod 2 = 0 Then      addr = Cells(i, 1).Address & ":" & Cells(i, 9).Address      Range(addr).Font.Color = RGB(0, 0, 255)   End If Next i End Sub

Change Cell border Style

Each range of cells can accept up to 8 different types of borders and borders means all borders around.

Left edge (xlEdgeLeft)

Top edge (xlEdgeTop)

Bottom edge (xlEdgeBottom)

Right edge (xlEdgeRight)

Inside vertical (xlInsideVertical)

Inside horizontal (xlInsideHorizontal)

Diagonal down (xlDiagonalDown)

Diagonal up (xlDiagonalUp)

 

Generally we’ve got 6 different kinds of border line style:

Continuous (xlContinuous)

Dot, (xlDot)

DashDotDot, (xlDashDotDot)

Dash, (xlDash)

SlantDashDot, (xlSlantDashDot)

Double, (xlDouble)

 

And there are 3 different border line thicknesses available:

Thin

Medium

Thick

Sub SetRangeBorder() 'Example 1  With Range("B2").Borders(xlEdgeBottom)     .LineStyle = xlContinuous     .Weight = xlThin     .Color = RGB(0, 0, 255)  End With 'Example 2  With Range("A4:E9").Borders     .LineStyle = xlDash     .Weight = xlThick End With 'Remove border Range("A4:E8").Borders.LineStyle = xlNone End Sub

Wrap text or change column width to get best fit

Sub text() ‘Wrap Text Range("A1").WrapText = True Cells(1, 1).WrapText = True ‘Autofit Range("A1:E1").Columns.AutoFit Columns("A:I").AutoFit End Sub

 

How to merge multiple worksheets into one worksheet horizontally or vertically via VBA

With the two macros described in this post, you will be able to combine multiple worksheets (of one workbook) into one (or master) worksheet. One macro is to copy data from different worksheets and paste them into one worksheet horizontally and the other one is to paste vertically.

First of all, below is the full program to merge different worksheets horizontally.

Sub Horizontal_Click() Application.DisplayAlerts = False 'Define variable Dim wbk As Workbook Dim ws As Worksheet 'Open workbook Set fnm = ThisWorkbook.Sheets(1).Cells(1, 2) Set wbk = Workbooks.Open(fnm) 'Set workbook as active workbook wbk.Activate 'Worksheets.count returns the number of worksheets For i = 1 To Worksheets.Count 'If there is a worksheet with name "Master" then delete this worksheet     If Worksheets(i).Name = "Master" Then         Worksheets(i).Delete     End If Next i 'Return number of all worksheet in the active workbook n = Worksheets.Count 'Add master worksheet after the last worksheet Set ws = Sheets.Add(After:=Worksheets(Worksheets.Count)) 'Give the newly added worksheet a name ws.Name = "Master" a = 0 'loop through all worksheets For i = 1 To n 'Get the number of rows with data for each worksheet x = Worksheets(i).UsedRange.Rows.Count 'Return the number of columns with data for each worksheet y = Worksheets(i).UsedRange.Columns.Count 'loop through all cells in each worksheet For p = 1 To x  For q = 1 To y    b = a + q    'copy and paste    ws.Cells(p, b) = Worksheets(i).Cells(p, q)  Next q Next p a = a + y Next i 'Close workbook and save changes wbk.Save wbk.Close End Sub

And here is the code for how to merge vertically. This macro is more complex than the above one. But it is also not complicated. You can look into code in red or highlighted in yellow to figure out how it works.

Sub Vertical_Click() Application.DisplayAlerts = False 'Define variable Dim wbk As Workbook Dim ws As Worksheet 'Open workbook Set fnm = ThisWorkbook.Sheets(1).Cells(1, 2) Set wbk = Workbooks.Open(fnm) 'Set workbook as active workbook wbk.Activate 'Worksheets.count returns the number of worksheets For i = 1 To Worksheets.Count 'If there is a worksheet with name "Master" then delete this worksheet     If Worksheets(i).Name = "Master" Then         Worksheets(i).Delete     End If Next i 'Return number of all worksheet in the active workbook n = Worksheets.Count 'Add master worksheet after the last worksheet Set ws = Sheets.Add(After:=Worksheets(Worksheets.Count)) 'Give the newly added worksheet a name ws.Name = "Master" a = 0 'loop through all worksheets For i = 1 To n 'Get the number of rows with data for each worksheet x = Worksheets(i).UsedRange.Rows.Count 'Return the number of columns with data for each worksheet y = Worksheets(i).UsedRange.Columns.Count 'Only the first row - column name - in the first worksheet will be kept, 'Otherwise, only data from the second row will be copied If i = 1 Then     For p = 1 To x      For q = 1 To y          b = a + p          ws.Cells(b, q) = Worksheets(i).Cells(p, q)      Next q     Next p ElseIf i > 1 Then     For p = 2 To x      For q = 1 To y          b = a + p          ws.Cells(b, q) = Worksheets(i).Cells(p, q)      Next q     Next p End If a = a + x - 1 Next i 'Close workbook and save changes wbk.Save wbk.Close End Sub

Only screenshot of combined worksheet in vertical way will be showed below. For the other case, you can run code and check by yourself.