Macro to set tab name equal to cell value

[ctish]

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!

 

[Norie]

Perhaps something like this which assumes it's B7 on the first sheet that you want to use for the tab name.

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]

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]

Perhaps something like this which assumes it's B7 on the first sheet that you want to use for the tab name.

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]

Oops, sorry about that - forgot to add the, quite important, part to close the workbooks.

I've added it in the code below.

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

 

[ctish]

Oops, sorry about that - forgot to add the, quite important, part to close the workbooks.

I've added it in the code below.

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!