Последовательное переименование листов - VBA
Формулировка задачи:
Приветствую!
Имеется макрос:
Работает корректно: переименовывает лист в книге2 как лист в книге1 и добавляет лист в книгу2.
Однако при запуске с помощью макроса:
выводится ошибка "1004":
"Нельзя присвоить листу имя, совпадающее с именем другого листа, библиотеки или книги, на которую ссылается VBA"
Причём ошибка выходит после того как один раз выполнен макрос "переименовать".
Что должно получиться:
При запуске макрос копирует наименование листа 1 в книге 1 и заменяет наименование листа в книге 2 на наименование листа 1 книги 1, затем создает в книге 2 лист 2.
Переходит в книге 1 на лист 2 и процедура повторяется.
Так происходит до последнего листа в книге 1.
Просьба помочь решить данную проблему.
Решение задачи: «Последовательное переименование листов»
textual
Листинг программы
Option Explicit
Sub tt()
Dim wb1 As Workbook, wb2 As Workbook, sh As Worksheet
Set wb1 = Workbooks("НаименованиеКниги1.xls")
Set wb2 = Workbooks("НаименованиеКниги2.xls")
For Each sh In wb1.Worksheets
If Not SheetExists(wb2, sh.Name) Then
With wb2: .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = sh.Name: End With
Call Пересобрать(sh, wb2.Sheets(sh.Name))
End If
Next
End Sub
Function SheetExists(wb As Workbook, SheetName As String) As Boolean
On Error Resume Next
SheetExists = Not wb.Sheets(SheetName) Is Nothing
End Function
Sub Пересобрать(sh1 As Object, sh2 As Object)
sh2.[a1:cv100].Formula = sh1.[a1:cv100].Formula 'тут диапазон нужно бы определять динамически...
sh1.Cells.Copy
sh2.Cells.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
sh2.Cells.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub