Всем привет, помогите допилить макрос, не могу разобраться
Макрос собирает данные с нескольких листов в книге и вставляет их на другой лист, в частности в макросе: собирает данные со всех листов в книге кроме листов Сводная и Сводник. Но как сделать так, чтобы я мог запустить этот макрос из книги, скажем под названием: Книга1, а он собрал данные с нескольких листов из Книги2, открыл её, собрал данные, закрыл, и все эти данные вставил на страницу: Сводная в Книге1. Т.е. проще говоря, исходные листы находятся в одной книге (Книга2), а сводник, куда собираются все данные находится в другой книге (Книга1).
На просторах интернета нашел такой макрос:
Он копирует диапазоны данных из активной открытой книги Excel нескольких листов (в нашем примере 3-х листов) в другую книгу, которая хранится в определенном месте. Данные будут вставлены как значения, плюс будут перенесены форматы ячеек.
Не знаю как их так соединить.
Может кто знает как реализовать?
| Код |
|---|
Sub Обновить_сводную()
Dim Sht As Worksheet
Dim Wb As Workbook
Dim i As Long
Dim iLastRow_B As Long
Dim iLastRow_Ai As Long
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
Set Wb = ThisWorkbook
Sheets("Сводная").Cells.Clear 'очищаем лист "Сводная"
Sheets("Сводная").Range("A1") = "Оценка"
Sheets("Сводная").Range("B1") = "ФИО сотрудника"
Sheets("Сводная").Range("C1") = "Старший"
Sheets("Сводная").Range("D1") = "Группа"
Sheets("Сводная").Range("E1") = "Дата оценки"
Sheets("Сводная").Range("F1") = "Номер звонка"
Sheets("Сводная").Range("G1") = "Пометка на звонок"
Sheets("Сводная").Range("H1") = "Проф. Навыки"
Sheets("Сводная").Range("I1") = "Навыки ведения диалога"
Sheets("Сводная").Range("J1") = "Общая оценка за звонок"
Sheets("Сводная").Range("K1") = "Тематика (1 уровень)"
Sheets("Сводная").Range("L1") = "Тематика (2 уровень)"
Sheets("Сводная").Range("M1") = "Тематика (3 уровень)"
Sheets("Сводная").Range("N1") = "Основная зона роста (1-ый уровень)"
Sheets("Сводная").Range("O1") = "Основная зона роста (2-ый уровень)"
Sheets("Сводная").Range("P1") = "Доп. зона роста (1-ый уровень)"
Sheets("Сводная").Range("Q1") = "Доп. зона роста (2-ый уровень)"
Sheets("Сводная").Range("R1") = "Вес нарушения Основной зоны"
Sheets("Сводная").Range("S1") = "Вес нарушения доп. Зоны"
Sheets("Сводная").Range("T1") = "ст"
Sheets("Сводная").Range("U1") = "Неделя"
Sheets("Сводная").Range("V1") = "Месяц"
Sheets("Сводная").Range("W1") = "Год"
Sheets("Сводная").Range("X1") = "Ошибка"
Sheets("Сводная").Range("Y1") = "Отдел"
Sheets("Сводная").Range("Z1") = "Кодировка"
i = 1
Set Sht = Wb.Sheets(i)
For Each Sht In Worksheets
If Sht.Name <> "Сводная" And Sht.Name <> "Сводник" Then
iLastRow_B = Cells(Rows.Count, 2).End(xlUp).Row
iLastRow_Ai = Wb.Sheets(i).Cells(Rows.Count, 1).End(xlUp).Row
Wb.Sheets(i).Range("A2:Z" & iLastRow_Ai).Copy Cells(iLastRow_B + 1, 1)
End If
i = i + 1
Next
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub |
На просторах интернета нашел такой макрос:
| Код |
|---|
Sub Копируем_листы_в_другую_книгу()
Dim bookconst As Workbook
Dim abook As Workbook
Set abook = ActiveWorkbook 'присваиваем перменную активной книге
Set bookconst = Workbooks.Open("C:\Users\User\Desktop\1.xlsx") 'присваиваем перменную книге куда необходимо копировать данные
'переходим в активную книгу откуда необходимо скопировать данные
abook.Worksheets("Лист1").Activate
Range("A1:I23").Copy 'копируем определенный диапазон листа, укажите свой диапазон
bookconst.Worksheets("Лист1").Activate 'активируем лист куда необходимо вставить данные
Range("A1:I23").Select 'встаем на ячейку А1
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'вставляем только форматы ячеек
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'второй лист
abook.Worksheets("Лист2").Activate
Range("A1:I23").Copy
bookconst.Worksheets("Лист2").Activate
Range("A1:I23").Select 'выделяем диапазон
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'вставляем только форматы ячеек
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'третий лист
abook.Worksheets("Лист3").Activate
Range("A1:I23").Copy
bookconst.Worksheets("Лист3").Activate
Range("A1:I23").Select 'выделяем диапазон
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'вставляем только форматы ячеек
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'сохранить текущую книгу
bookconst.Save
'Закрыть книгу
bookconst.Close
abook.Activate
End Sub |
Не знаю как их так соединить.
Может кто знает как реализовать?
