luizhcosta,

Boa tarde!

Veja se é assim.

Não cheguei a ver os modelos dos colegas, mas segue uma sugestão:

Sub RenomeiaAbas()
    Dim MyNames As Variant
    Dim MyNames2 As Variant
    Dim ws As Worksheet
    Dim MyRange As Range
    Dim MyRange2 As Range
    Dim i As Long
    Dim X As Long

    With Sheets("Plan1")
        Set MyRange = .Range("A2", .Range("A" & .Rows.Count).End(xlUp).Address)
        '~~> passa os names para array
        MyNames = Application.Transpose(MyRange)
        i = LBound(MyNames)
    
        Set MyRange2 = .Range("B2", .Range("B" & .Rows.Count).End(xlUp).Address)
        '~~> passa os names para array
        MyNames2 = Application.Transpose(MyRange2)
        X = LBound(MyNames2)
    
    End With

    For Each ws In Worksheets
        If ws.Name <> "Plan1" Then
            
            sShtA = MyNames(i)
            sShtB = MyNames2(X)
            
            'Renomeia com os Valores do Array
            Sheets(sShtA).Name = MyNames2(X)
                
            i = i + 1
            X = X + 1
       
        End If
        
    Next ws

End Sub

Se a rotina for igual a dica do Wag, favor desconsidere este.

[]s

Obrigado Wag e Mauro.

As soluções estão perfeitas. Os códigos tem suas particularidades e serão muito estudados.

Obrigado.