Worksheet named based on cell value

[alansbanans]

Hi, first off I have gone through a number of posts that seem the same/similar to my request but the code will not work for me.

I have 33 worksheets that I would like to be renamed by the value in A2 on each of those sheets. Ex. If Sheet3 has 12345 in A2, I would like that sheet named “12345”.

I have tried a number of different forum answers including here and none of the code works for me.

Thanks so much in advance.

 

[Joe4]

Welcome to the Board!

Assuming you don't have any duplicates values in cell A2 across your sheets, and assuming you have valid characters in them, this should do it:

Sub RenameSheets()

    Dim ws As Worksheet
    
'   Loop through all worksheets
    For Each ws In Worksheets
        If ws.Range("A2") <> "" Then
            ws.Name = ws.Range("A2")
        End If
    Next ws
    
End Sub

 

[HighAndWilder]

Hi, first off I have gone through a number of posts that seem the same/similar to my request but the code will not work for me.

I have 33 worksheets that I would like to be renamed by the value in A2 on each of those sheets. Ex. If Sheet3 has 12345 in A2, I would like that sheet named “12345”.

I have tried a number of different forum answers including here and none of the code works for me.

Thanks so much in advance.

Give this a go. It checks for duplicates.

Run the subRenameWorksheets procedure.

It does not check for invalid worksheet names.

Public Sub subRenameWorksheets()
Dim Ws As Worksheet
Dim strNames As String

  For Each Ws In ThisWorkbook.Worksheets
    
    With Ws
    
      If Not IsEmpty(.Range("A2").Value) Then
      
        If Not fncWorksheetExists(.Range("A2").Value) Then
      
          .Name = .Range("A2").Value
    
        Else
        
          strNames = strNames & vbCrLf & .Range("A2").Value & "  " & Ws.Name
          
        End If
      
      End If
    
    End With
  
  Next Ws
  
  MsgBox strNames, vbOKOnly, "Worksheets not renamed."
  
  ActiveWorkbook.Save

End Sub

Private Function fncWorksheetExists(strWorksheet As String) As Boolean
Dim Ws As Worksheet

  For Each Ws In ThisWorkbook.Worksheets
    
    If Ws.Name = strWorksheet Then
      
      fncWorksheetExists = True
      
      Exit Function
      
    End If
  
  Next Ws

End Function

 

[alansbanans]

Sub RenameSheets() Dim ws As Worksheet ' Loop through all worksheets For Each ws In Worksheets If ws.Range("A2") <> "" Then ws.Name = ws.Range("A2") End If Next ws End Sub

Thank you!!!

 

[Joe4]

You are welcome.
Glad we were able to help!