CODEWITHSUNDEEP
vbaexcel
Dipanshu
Dipanshu

Reputation: 27

Change Tabs name by using a list and find function in VBA

I have a list of names in one workbook in column b and I have to change the name of tabs of a different workbook in which several tabs.

These tabs have that name in it but not in the same place on every sheet. So, I need to find the name in the workbook by using the list, that I have in a different workbook in b column.

Is there any VBA code for that because I am not able to find that particular name in the workbook by using Find in VBA.
Here is the Code which i am trying to use but not able to get the desired result

Sub change_Name_1 ()
For i = 1 To Application.Sheets.Count
    Windows("Book2").Activate
    b = Range("B" & i).Value
    Windows("Book1").Activate
    Sheets(i).Select
    Cells.Find(What:=b, After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveSheet.Select
    ActiveSheet.Name = b
    Next
End Sub

Image of excel file in which I have the name

enter image description here

And this is the second image in which name is not in particular cell of every tab

enter image description here

Upvotes: 1

Views: 437

Answers (1)

SJR
SJR

Reputation: 23081

Can you try this? You will get an error if trying to activate a range which does not exist so you need to first check that the value is found.

Sub change_Name_1()

Dim wb1 As Workbook, wb2 As Workbook, ws As Worksheet, r As Range, r1 As Range

Set wb1 = Workbooks("Book1") 'change names to suit
Set wb2 = Workbooks("Book2")

For Each r In wb2.Sheets(1).Range("B1", wb2.Sheets(1).Range("B" & Rows.Count).End(xlUp))
    For Each ws In wb1.Worksheets
        Set r1 = ws.UsedRange.Find(What:=r, LookIn:=xlValues, LookAt:=xlWhole, _
                                   MatchCase:=False, SearchFormat:=False)
        If Not r1 Is Nothing Then
            ws.Name = r
            Exit For
        End If
    Next ws
Next r

End Sub

Upvotes: 1

Related Questions