T4483_Rename Worksheets By List Using Loops

https://excel-egy.com/forum/t4483
---------------------------------

Sub Rename_Worksheets_By_List_Using_Loops()
    Dim ws As Worksheet, rng As Range, cnt As Long, i As Long

    Set ws = ThisWorkbook.Worksheets(1)
    Set rng = ws.Range("A2:A" & ws.Cells(Rows.Count, 1).End(xlUp).Row)
    cnt = ThisWorkbook.Worksheets.Count
    If cnt <> rng.Cells.Count Then MsgBox "Worksheets Number Not The Same", vbExclamation: Exit Sub

    For i = 1 To cnt
        ThisWorkbook.Worksheets(i).Name = CStr(ws.Cells(i + 1, 1).Value)
    Next i

    MsgBox "Done...", 64
End Sub