Создаю новую книгу и перемещаю из исходной в неё данные.
Есть два поля, которые забиваются данными из кода.
Если страница одна, то код работает отлично. Если страниц больше, то корректно выглядит только первая. Остальные - заполняется только тот столбец, куда происходит копирование из исходной. А поля, которые должны быть заполнены из кода - заполняются только на одну ячейку.
В чем проблема?
Скрытый текст |
|---|
| Код |
|---|
Sub AddEldoradoBookMod()
Dim firstBook As Excel.Workbook, secondBook As Excel.Workbook
Set firstBook = ActiveWorkbook
'Создание новой книги с таким же количеством листов, как и в исходной
Application.SheetsInNewWorkbook = firstBook.Worksheets.Count
Set secondBook = Workbooks.Add
'переменная для цикла - равна количеству листов
countSheets = firstBook.Worksheets.Count
'Цикл для перебора листов
Do Until countSheets = "0"
'Копирование столбца А в А новой книги
firstBook.Worksheets(countSheets).Columns("A").Copy
secondBook.Worksheets(countSheets).Range("A1").PasteSpecial
'Заполнение столбца B с ячейки B2 данными до конца таблицы (конец вычисляю по столбцу A)
secondBook.Worksheets(countSheets).Range("B2:B" & Cells(Rows.Count, 1).End(xlUp).Row).Value = "Клиент"
'Тоже самое но в C
secondBook.Worksheets(countSheets).Range("C2:C" & Cells(Rows.Count, 1).End(xlUp).Row).Value = "-"
secondBook.Worksheets(countSheets).Columns("C:C").HorizontalAlignment = xlCenter
secondBook.Worksheets(countSheets).Range("A1").Value = "ФИО"
secondBook.Worksheets(countSheets).Range("B1").Value = "Статус"
secondBook.Worksheets(countSheets).Range("C1").Value = "Прочерк"
'Применение стиля
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Interior.Pattern = xlNone
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Borders(xlDiagonalDown).LineStyle = xlNone
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Borders(xlDiagonalUp).LineStyle = xlNone
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Borders(xlEdgeLeft).LineStyle = xlContinuous
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Borders(xlEdgeTop).LineStyle = xlContinuous
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Borders(xlEdgeBottom).LineStyle = xlContinuous
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Borders(xlEdgeRight).LineStyle = xlContinuous
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Borders(xlInsideVertical).LineStyle = xlContinuous
Range("A1", ActiveCell.SpecialCells(xlLastCell)).Borders(xlInsideHorizontal).LineStyle = xlContinuous
secondBook.Worksheets(countSheets).Cells.EntireColumn.AutoFit
secondBook.Worksheets(countSheets).Name = secondBook.Worksheets(countSheets).Range("A2").Value
countSheets = countSheets - 1
Loop
End Sub |
|
