Все доброго дня! мучаюсь второй день.
есть лист с таблицей, который нужно клонировать/копировать и в заголовок каждого листа нужно вставить данные из столбца этой же книги или другой не так уж важно. Вставка по порядку: лист1 - заголовок ячейка Ай, Лист2 - ячейка - а2 и так далее до n
Пример 1: копировать лист "kletki", в заголовок каждого листа вставить данные с "Sheet1"
Без Вашего файла-примера и показанных попыток так и будете мучиться дальше...
добавил файл!
Сначала удаляются все листы, кроме двух исходных, потом создаются новые по количеству имен в таблице.
Лист с шахматкой скрыт. Если нужно, отобразите, на работе макроса не скажется.
Проверку на дубли не делал. Если в таблице встретятся одинаковые имена - ошибка при создании листа.
Добавил обработку дублей:
Option Explicit
Sub NewSheets()
Dim sht As Worksheet
Dim lRw As Long
Dim COL As New Collection
Dim a As Variant
With wsName
lRw = .Cells(.Rows.Count, "A").End(xlUp).Row
If lRw < 2 Then Exit Sub
On Error Resume Next 'что бы не "вылетать" на дубликатах при создании коллекции
For Each a In .Range("A2:A" & lRw).Value: COL.Add CStr(a), CStr(a): Next a
On Error GoTo 0 'что бы увидеть последующие ошибки
End With
With Application: .ScreenUpdating = False: .DisplayAlerts = False: End With
' в цикле удаляем все листы, кроме двух
For Each sht In Worksheets
If Not (sht.Name = ws0.Name Or sht.Name = wsName.Name) Then sht.Delete
Next sht
For Each a In COL
ws0.Copy Before:=Sheets(1) ' копируем лист
With Sheets(1)
.Visible = xlSheetVisible ' отображаем новый лист
.Name = a ' имя нового листа
.Range("C2").Value = a ' имя в ячейку
End With
Next a
With Application: .ScreenUpdating = True: .DisplayAlerts = True: End With
End Sub
Спасибо огромное.
Скажите еще как увеличить количество знаков в строке, которая вставляется в шапку, не дает больше 32...
Странно... 255 должно разрешать без проблем. да и больше можно...
Подозреваю это связано с тем, что лист обзывается именем ячейки, подскажите как убрать это, пусть именуются Лис 1, Лист 2 и т.д., или sheet1....
Да, точно ругается на длину имени листа больше 32 символов.
Имена листов вообще не важны, важно чтобы могла вставляться большая подпись из колонок ..
Помогите !
Переменная i как счетчик, а название "Лист" можете поменять
Option Explicit
Sub NewSheets()
Dim sht As Worksheet
Dim lRw As Long
Dim COL As New Collection
Dim a As Variant
With wsName
lRw = .Cells(.Rows.Count, "A").End(xlUp).Row
If lRw < 2 Then Exit Sub
On Error Resume Next 'что бы не "вылетать" на дубликатах при создании коллекции
For Each a In .Range("A2:A" & lRw).Value: COL.Add CStr(a), CStr(a): Next a
On Error GoTo 0 'что бы увидеть последующие ошибки
End With
With Application: .ScreenUpdating = False: .DisplayAlerts = False: End With
' в цикле удаляем все листы, кроме двух
For Each sht In Worksheets
If Not (sht.Name = ws0.Name Or sht.Name = wsName.Name) Then sht.Delete
Next sht
Dim i As Long
For Each a In COL
i = i + 1
ws0.Copy Before:=Sheets(1) ' копируем лист
With Sheets(1)
.Visible = xlSheetVisible ' отображаем новый лист
.Name = "Лист" & i 'a ' имя нового листа. кроме "Sheet"
.Range("C2").Value = a ' имя в ячейку
End With
Next a
With Application: .ScreenUpdating = True: .DisplayAlerts = True: End With
End Sub
Спасибо огромное ГУРУ!
Все заработало!