Добрый день!
Есть общая база данных "База предписаний Общая". В данной базе три вкладки УН, ИБН-Р, ИВУТТ.
Необходимо скопировать данные из "База предписаний Общая" в отдельные файлы "База предписаний УН", "База предписаний ИВУТТ", "База предписаний ИБН-Р".
Только определенные диапазоны.
Из "База предписаний Общая" С6:G6, J6 в "База предписаний УН" С6:Н6 - значения выделены зеленым и синим цветом в прилагаемых таблицах. - данный диапазон постоянный и не меняется.
Из "База предписаний Общая" А63:Y65 в "База предписаний УН" A12:Y14 - значения выделены красным цветом в прилагаемых таблицах. - данный диапазон меняется по нижнему значению.
Проблема в том, что "База предписаний Общая" постоянно дополняется и диапазон А63:Y65 увеличивается А63:Y80, А63:Y159 и т.д.
Написал макрос (корявенький).
И в строке Range("A63:Y65").Select приходится вручную прописывать последнюю строку Y80 Y159 и т.д.
Есть ли возможность написать макрос который сам будет создавать файлы "База предписаний УН", "База предписаний ИВУТТ", "База предписаний ИБН-Р" и не нужно будет в нем прописывать меняющийся диапазон "A63:Y65". Данные в "База предписаний УН" С6:Н6 необходимо вставлять как значения, чтобы убрать ссылки на формулы.
Sub Название_Макроса2()
Workbooks.Open Filename:="C:\....\База предписаний Общая.xlsx"
'Скопировать нужный диапазон в открывшейся книге
Sheets("УН").Select
Range("A63:Y65").Select
Selection.Copy
'Выделяем и вставляем скопированные данные в ячейку A12
Windows("База предписаний УН.xlsx").Activate
Sheets("УН").Select
Range("A12").Select
ActiveSheet.Paste
Windows("База предписаний Общая.xlsx").Activate
Sheets("УН").Select
Range("C6:G6").Select
Selection.Copy
Windows("База предписаний УН.xlsx").Activate
Sheets("УН").Select
Range("C6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("База предписаний Общая.xlsx").Activate
Sheets("УН").Select
Range("J6").Select
Selection.Copy
Windows("База предписаний УН.xlsx").Activate
Sheets("УН").Select
Range("H6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Закрываем книгу
Workbooks("База предписаний УН.xlsx").Save
Workbooks("База предписаний УН.xlsx").Close
Windows("База предписаний Общая.xlsx").Activate
Workbooks("База предписаний Общая.xlsx").Save
Workbooks("База предписаний Общая.xlsx").Close
End Sub
Здравствуйте
Цитата: alfatboy от 17.02.2022, 13:06
И в строке Range("A63:Y65").Select приходится вручную прописывать последнюю строку Y80 Y159 и т.д.
Последнюю заполненную строку можно искать так (для первого столбца):
Dim LastRow As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
MsgBox LastRowRange("c1:c" & LastRow).SelectЭта строка кода выделит все те ячейки третьего столбца, напротив которых в первом столбце есть данные
Спасибо за подсказку.
Изменил код. Вроде работает, но при работе выдает сообщение "Microsoft Excel 73"
Может что-то не так прописал?
Sub Название_Макроса2()
Workbooks.Open Filename:="C:\Users\solovevai1\Documents\1.База предписаний\Образец базы\Копирование Базы\Пример\База предписаний Общая.xlsx"
'Скопировать нужный диапазон в открывшейся книге
Sheets("УН").Select
Dim LastRow As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
MsgBox LastRow
Range("a63:y" & LastRow).Select
Selection.Copy
'Выделяем и вставляем скопированные данные в ячейку A12
Windows("База предписаний УН.xlsx").Activate
Sheets("УН").Select
Range("A12").Select
ActiveSheet.Paste
Windows("База предписаний Общая.xlsx").Activate
Sheets("УН").Select
Range("C6:G6").Select
Selection.Copy
Windows("База предписаний УН.xlsx").Activate
Sheets("УН").Select
Range("C6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("База предписаний Общая.xlsb").Activate
Sheets("УН").Select
Range("J6").Select
Selection.Copy
Windows("База предписаний УН.xlsx").Activate
Sheets("УН").Select
Range("H6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Закрываем книгу
End Sub
Цитата: alfatboy от 17.02.2022, 14:58...при работе выдает сообщение "Microsoft Excel 73"...
На какой строке кода? Приложите скрин
PS Используйте теги "Код" для оформления кодов макросов
Добрый день!
Это не ошибка, это сообщение до какой строки было произведено копирование.
Так-то не мешает, просто "ОК" нажимаешь.
Спасибо за помощь.
Цитата: alfatboy от 18.02.2022, 13:28Это не ошибка, это сообщение до какой строки было произведено копирование.
Вот эту строку из кода удалите или закомментируйте:
MsgBox LastRow
Спасибо за подсказку. Сообщение пропало.