Probeer 'm zo 'ns...
Sub Hernoemen()
SheetTabel = Sheets(1).Cells(1).CurrentRegion
For i = 2 To UBound(SheetTabel, 1)
' test of een sheet bestaat
Set WS = Nothing
On Error Resume Next
Set WS = Sheets(SheetTabel(i, 1))
If Not WS Is Nothing Then
' oude naam is gevonden, dan aanpassen
Sheets(SheetTabel(i, 1)).Name = SheetTabel(i, 2)
Sheets(1).Hyperlinks.Add Cells(i, 2), "", Sheets(SheetTabel(i, 2)).Name & "!" & Cells(1).Address, CStr(SheetTabel(i, 2))
Else
MsgBox "De sheet '" & SheetTabel(i, 1) & "' is niet gevonden!", vbOKOnly, "Niet gevonden"
End If
Next i
End Sub
Naar mijn idee is het niet verstandig om de oude namen zomaar te overschrijven in je tabel. Ik heb er dus voor gekozen om de namen in kolom B te voorzien van een hyperlink. Zo kan je later altijd nog kolom A handmatig deleten.