Я не могу заставить Excel создать новый лист в макросе VBA - PullRequest
Новая
       36

Я не могу заставить Excel создать новый лист в макросе VBA

0 голосов
/ 25 января 2019

Я сохранил 1-й рабочий лист «Мастер», где столбец А - это код продукта. 2-й лист - «Шаблон».

Цель состояла в том, чтобы создать новый лист из значения ячейки в столбце A, скопировать данные из листа шаблона на новый лист, переименовать лист и создать гиперссылку на значение ячейки, поэтому, если я нажму на ячейку, она перейдет на новый лист .

Теперь выдает ошибку при создании нового блога. Во-вторых, когда я добавляю больше данных в столбец A и снова запускаю макрос, он не создает новые листы. 

Sub CreateAndNameWorksheets()
   Dim c As Range
   Application.ScreenUpdating = False

   For Each c In Sheets("Master").Range("A5:A50")
        Sheets("Template").Copy After:=Sheets(Sheets.Count)
        With c
            ActiveSheet.Name = .Value
            .Parent.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:= _
                "'" & .Text & "'!A1", TextToDisplay:=.Text
        End With
    Next c
    Application.ScreenUpdating = True
End Sub

Ответы [ 2 ]

0 голосов
/ 25 января 2019

... и если у вас еще нет гиперссылки на мастер-лист в вашем шаблоне, вы можете добавить ее на каждый новый лист следующим образом: 

ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Range("A1"), Address:="", SubAddress:= _
    "'Master'!A" & c.Row, TextToDisplay:="Back"
0 голосов
/ 25 января 2019

Если вы не измените ALL данные в A5:A50, вы не сможете запустить его во второй раз.Excel требует уникального имени для каждого листа.Однако вы можете создать обработчик ошибок, если имя листа уже существует, и пропустить эту ячейку в цикле.Кроме того, если у вас есть пустая ячейка и вы пытаетесь установить имя листа в этой ячейке, это также приведет к ошибке.

Для функционального ответа вы можете использовать что-то вроде этого 

Sub CreateAndNameWorksheets()
Dim c As Range
Dim errTest As Worksheet
Application.ScreenUpdating = False

On Error GoTo eHandler

For Each c In Sheets("Master").Range("A5:A50")
    With c
        Set errTest = Sheets(.Value)
        If .Value <> "" And errTest Is Nothing Then
            Sheets("Template").Copy After:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = .Value
            .Parent.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:= _
                "'" & .Text & "'!A1", TextToDisplay:=.Text
        End If
    End With
Next c

Application.ScreenUpdating = True
Exit Sub
eHandler:
If Err.Number = 9 Then
    Set errTest = Nothing
    Resume Next
Else
    Application.ScreenUpdating = True
    MsgBox Err.Number & vbCrLf & Err.Description
End If
End Sub
...