Всем привет, помогите допилить макрос, не могу разобраться
Макрос собирает данные с нескольких листов в книге и вставляет их на другой лист, в частности в макросе: собирает данные со всех листов в книге кроме листов Сводная и Сводник. Но как сделать так, чтобы я мог запустить этот макрос из книги, скажем под названием: Книга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 |
Не знаю как их так соединить.
Может кто знает как реализовать?