Macro to set tab name equal to cell value

ctish

New Member
Joined
Jan 28, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
  3. Web
I am looking to be able to run a macro that will allow me to choose a folder with all of my workbooks and set the first tab name to equal the value of cell B7. All the workbooks are the same. Ideally it would open a file, make the tab name equal to the text in B7, save-as, close, open the next file and so on until the files have all been run through inside the folder. I am pretty new to the macro world so bear with me. Thanks in advance!
 

Some videos you may like

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,270
Office Version
  1. 365
Platform
  1. Windows
Perhaps something like this which assumes it's B7 on the first sheet that you want to use for the tab name.
VBA Code:
Public Function GetFolder(Optional OpenAt As String, Optional strTitle = "Please select folder") As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .InitialFileName = OpenAt
        .Title = strTitle
        .Show
        If .SelectedItems.Count <> 0 Then
            GetFolder = .SelectedItems(1)
        End If
    End With
    
End Function

Sub ChangeTabName()
Dim wb As Workbook
Dim objFSO As Object
Dim objFile As Object
Dim objFolder As Object
Dim strFolder As String

    strFolder = GetFolder
    
    If strFolder = "" Then
        MsgBox "No folder selected!", vbInformation, "No folder selected"
    End If
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    Set objFolder = objFSO.GetFolder(strFolder)
    
    For Each objFile In objFolder.Files
        If objFile.Type Like "*Excel*" Then
            Set wb = Workbooks.Open(objFile.Path)
            wb.Sheets(1).Name = wb.Sheets(1).Range("B7").Value
        End If
    Next objFile
    
End Sub
 

ctish

New Member
Joined
Jan 28, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
  3. Web
Looks like it gets hung up on the last line before "End If". The line highlighted is wb.Sheets(1).Name = wb.Sheets(1).Range("B7").Value

The error code I get is Run-time error '13': Type mismatch.
 

ctish

New Member
Joined
Jan 28, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
  3. Web
Perhaps something like this which assumes it's B7 on the first sheet that you want to use for the tab name.
VBA Code:
Public Function GetFolder(Optional OpenAt As String, Optional strTitle = "Please select folder") As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .InitialFileName = OpenAt
        .Title = strTitle
        .Show
        If .SelectedItems.Count <> 0 Then
            GetFolder = .SelectedItems(1)
        End If
    End With
  
End Function

Sub ChangeTabName()
Dim wb As Workbook
Dim objFSO As Object
Dim objFile As Object
Dim objFolder As Object
Dim strFolder As String

    strFolder = GetFolder
  
    If strFolder = "" Then
        MsgBox "No folder selected!", vbInformation, "No folder selected"
    End If
  
    Set objFSO = CreateObject("Scripting.FileSystemObject")
  
    Set objFolder = objFSO.GetFolder(strFolder)
  
    For Each objFile In objFolder.Files
        If objFile.Type Like "*Excel*" Then
            Set wb = Workbooks.Open(objFile.Path)
            wb.Sheets(1).Name = wb.Sheets(1).Range("B7").Value
        End If
    Next objFile
  
End Sub
Disregard my previous reply. The macro works to place the value of B7 once I eliminated an unneeded extra sheet in each workbook. The only thing now is I need it to run so that once the function of placing the value of B7 in the tab name, I need it to save the file and close it. As is, it opens the file, changes the tab name, then leaves it unsaved and open. Thanks for the quick response!
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,270
Office Version
  1. 365
Platform
  1. Windows
Oops, sorry about that - forgot to add the, quite important, part to close the workbooks.:eek:

I've added it in the code below.
VBA Code:
Option Explicit

Public Function GetFolder(Optional OpenAt As String, Optional strTitle = "Please select folder") As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .InitialFileName = OpenAt
        .Title = strTitle
        .Show
        If .SelectedItems.Count <> 0 Then
            GetFolder = .SelectedItems(1)
        End If
    End With
   
End Function

Sub ChangeTabName()
Dim wb As Workbook
Dim objFSO As Object
Dim objFile As Object
Dim objFolder As Object
Dim strFolder As String

    strFolder = GetFolder
   
    If strFolder = "" Then
        MsgBox "No folder selected!", vbInformation, "No folder selected"
    End If
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
   
    Set objFolder = objFSO.GetFolder(strFolder)
   
    For Each objFile In objFolder.Files
        If objFile.Type Like "*Excel*" Then
            Set wb = Workbooks.Open(objFile.Path)
            wb.Sheets(1).Name = wb.Sheets(1).Range("B7").Value
            wb.Close SaveChanges:=True
        End If
    Next objFile
   
End Sub
 
Solution

ctish

New Member
Joined
Jan 28, 2021
Messages
6
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
  3. Web
Oops, sorry about that - forgot to add the, quite important, part to close the workbooks.:eek:

I've added it in the code below.
VBA Code:
Option Explicit

Public Function GetFolder(Optional OpenAt As String, Optional strTitle = "Please select folder") As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .InitialFileName = OpenAt
        .Title = strTitle
        .Show
        If .SelectedItems.Count <> 0 Then
            GetFolder = .SelectedItems(1)
        End If
    End With
  
End Function

Sub ChangeTabName()
Dim wb As Workbook
Dim objFSO As Object
Dim objFile As Object
Dim objFolder As Object
Dim strFolder As String

    strFolder = GetFolder
  
    If strFolder = "" Then
        MsgBox "No folder selected!", vbInformation, "No folder selected"
    End If
  
    Set objFSO = CreateObject("Scripting.FileSystemObject")
  
    Set objFolder = objFSO.GetFolder(strFolder)
  
    For Each objFile In objFolder.Files
        If objFile.Type Like "*Excel*" Then
            Set wb = Workbooks.Open(objFile.Path)
            wb.Sheets(1).Name = wb.Sheets(1).Range("B7").Value
            wb.Close SaveChanges:=True
        End If
    Next objFile
  
End Sub
That's amazing! Works like a charm! This saves me hours of time. Thank you so much!
 

Watch MrExcel Video

Forum statistics

Threads
1,127,387
Messages
5,624,402
Members
416,026
Latest member
melvic69

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top