Измените имя вкладки с помощью списка и найдите функцию в VBA - PullRequest
0 голосов
/ 02 мая 2018

У меня есть список имен в одной книге в столбце 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, в котором у меня есть имя

enter image description here

И это второе изображение, в котором имя не находится в отдельной ячейке каждой вкладки

enter image description here

1 Ответ

0 голосов
/ 02 мая 2018

Можете ли вы попробовать это? Вы получите сообщение об ошибке, если попытаетесь активировать диапазон, который не существует, поэтому вам нужно сначала проверить, что значение найдено.

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...