使用VBA中的列表和查找功能更改选项卡名称

Question

我在列b中的一个工作簿中有一个名称列表，我必须更改其中包含多个选项卡的不同工作簿的选项卡名称。

这些标签中包含该名称，但不在每张纸上的相同位置。因此，我需要使用列表在工作簿中找到该名称，我在b column中的不同工作簿中找到了该名称。

是否有任何VBA代码，因为我无法通过在VBA中使用查找在工作簿中找到该特定名称。
这是我试图使用但无法获得所需结果的代码

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

excel文件的图片，其中我有名字

这是第二个图像，其中名称不是每个标签的特定单元格

Answer 1

你能试试吗？如果尝试激活不存在的范围，则会出现错误，因此您需要先检查是否找到了该值。

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