Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Автоматическое создание листов и гиперссылок по списку, Гиперссылки, автоматизация
 
Здравствуйте. Не могу решить вот такую задачку.
Есть книга, в которой будет список имен. Имена будут постоянно добавляться в определенном столбце. необходимо, чтобы при добавлении нового имени создавался с соответствующим именем лист и с определенным шаблоном. Заранее спасибо.
Изменено: feeling - 13 Июн 2018 16:09:03
 
feeling, https://www.planetaexcel.ru/techniques/3/60/
 
Это не совсем то. что мне нужно. А нужно, чтобы при построчном вводе нового имени на первом листе автоматически в этой же книге создавался лист (желательно с готовым заданным шаблоном) с таким же именем, и гиперссылка на него в ячейке, где было введено новое имя. А в приведенной ссылке все методы требуют создания листов вручную А если мне таких листов надо создать 100? их содержимое при этом будет отличаться всего лишь значением в одной ячейке, а остальное будет по шаблону. Не очень хочется создавать 100 листов вручную.
Изменено: feeling - 14 Июн 2018 19:14:40
 
Заполнили строку с очередной фамилией - запустили макрос
Код
Sub CreateSheet()
Dim iShtName As String
Dim iLastRow As Long
Dim Imena As Worksheet
   Set Imena = ThisWorkbook.Worksheets("Имена")
 iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
 iShtName = Range("B" & iLastRow)
  If Not SheetExist(iShtName) Then  'функция проверки наличия листа в файле
    Worksheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = iShtName
    Range("A1") = iShtName
    Imena.Range("C2:E2").Copy Range("B4")
    Imena.Range("C" & iLastRow & ":E" & iLastRow).Copy Range("B5")
    Imena.Activate
    ActiveSheet.Hyperlinks.Add anchor:=Range("B" & iLastRow), Address:="", _
                    SubAddress:="'" & iShtName & "'" & "!A1"
  End If
End Sub
     'функция проверки наличия листа в файле, лист есть - true
Function SheetExist(iName As String) As Boolean
    On Error Resume Next
    With Worksheets(iName): End With
    SheetExist = (Err = 0)
End Function
 
Спасибо огромное! Это именно то, что нужно!
Страницы: 1
Читают тему (гостей: 1)