Добрый день! Просмотрел много тем на форуме, но что-то похожее не смог найти. Возможно тема была, заранее извиняюсь за дублирование и прошу скинуть ссылку. Мне приходится распечатывать большое количество однотипных заявлений и чтобы не создавать много файлов, хотелось чтобы была одна таблица, где отображались уже распечатанные заявления. Задача в следующем: Автоматически добавлять данные из 5 ячеек (H2:L2) с одного листа (МО ЭЗ к Р1), в таблицу на другом листе (Распечатанные заявления) с подстановкой даты и наименованием листа с добавлением новой строки в начало таблицы. Пример приложил.
Заранее премного благодарен за ответ!
Добрый день! Просмотрел много тем на форуме, но что-то похожее не смог найти. Возможно тема была, заранее извиняюсь за дублирование и прошу скинуть ссылку. Мне приходится распечатывать большое количество однотипных заявлений и чтобы не создавать много файлов, хотелось чтобы была одна таблица, где отображались уже распечатанные заявления. Задача в следующем: Автоматически добавлять данные из 5 ячеек (H2:L2) с одного листа (МО ЭЗ к Р1), в таблицу на другом листе (Распечатанные заявления) с подстановкой даты и наименованием листа с добавлением новой строки в начало таблицы. Пример приложил.
AlexanderRogolev, здравствуйте. Не поняла в какую таблицу нужно новую строку вставлять, а остальное проверяйте[vba]
Код
Sub add_() Application.ScreenUpdating = False Dim sh1, sh2 Dim r As Long Set sh1 = ThisWorkbook.Sheets("Распечатанные заявления") Set sh2 = ThisWorkbook.Sheets("МО ЭЗ к Р1") r = sh1.Cells(Rows.Count, 1).End(xlUp).Row + 1 sh1.Range("A" & r & ":e" & r).Value = sh2.Range("H2:L2").Value sh1.Range("f" & r) = Now sh1.Range("g" & r) = sh2.Name sh1.Rows(r - 1).Copy sh1.Rows(r).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
[/vba]
AlexanderRogolev, здравствуйте. Не поняла в какую таблицу нужно новую строку вставлять, а остальное проверяйте[vba]
Код
Sub add_() Application.ScreenUpdating = False Dim sh1, sh2 Dim r As Long Set sh1 = ThisWorkbook.Sheets("Распечатанные заявления") Set sh2 = ThisWorkbook.Sheets("МО ЭЗ к Р1") r = sh1.Cells(Rows.Count, 1).End(xlUp).Row + 1 sh1.Range("A" & r & ":e" & r).Value = sh2.Range("H2:L2").Value sh1.Range("f" & r) = Now sh1.Range("g" & r) = sh2.Name sh1.Rows(r - 1).Copy sh1.Rows(r).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
Manyasha, добрый день! Протестировал данное решение, ничего не происходит. Возможно не точно объяснил суть проблемы, попробую развернуто. Ведется основная таблица откуда я беру информацию (№бс, индекс, регион, адрес, заказчик) для моих заявлений. Эту информацию я вставляю в данный файл в книгу "МО ЭЗ к Р1", после чего распечатываю его. Так вот, после того, как я вставил (№бс, индекс, регион, адрес, заказчик) в книгу "МО ЭЗ к Р1" или после распечатывания заявления, хотелось чтобы (№бс, индекс, регион, адрес, заказчик, дата и наим. книги) вставлялись в таблицу "Распечатанные заявления". Вверху новые заявления, в самом низу соответственно старые.
Manyasha, добрый день! Протестировал данное решение, ничего не происходит. Возможно не точно объяснил суть проблемы, попробую развернуто. Ведется основная таблица откуда я беру информацию (№бс, индекс, регион, адрес, заказчик) для моих заявлений. Эту информацию я вставляю в данный файл в книгу "МО ЭЗ к Р1", после чего распечатываю его. Так вот, после того, как я вставил (№бс, индекс, регион, адрес, заказчик) в книгу "МО ЭЗ к Р1" или после распечатывания заявления, хотелось чтобы (№бс, индекс, регион, адрес, заказчик, дата и наим. книги) вставлялись в таблицу "Распечатанные заявления". Вверху новые заявления, в самом низу соответственно старые.AlexanderRogolev
Sub add_() Application.ScreenUpdating = False Dim sh1, sh2 Dim r As Long Set sh1 = ThisWorkbook.Sheets("Распечатанные заявления") Set sh2 = ThisWorkbook.Sheets("МО ЭЗ к Р1") sh1.Rows("2:2").Insert Shift:=xlDown sh1.Range("A2:E2").Value = sh2.Range("H2:L2").Value sh1.Range("F2") = Format(Now, "dd/mm/yyyy h:mm;@") sh1.Range("G2") = sh2.Name sh1.Rows(3).Copy sh1.Rows(2).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
[/vba]
Нажимайте на кнопку на листе "МО ЭЗ к Р1"
AlexanderRogolev, поправила макрос:
[vba]
Код
Sub add_() Application.ScreenUpdating = False Dim sh1, sh2 Dim r As Long Set sh1 = ThisWorkbook.Sheets("Распечатанные заявления") Set sh2 = ThisWorkbook.Sheets("МО ЭЗ к Р1") sh1.Rows("2:2").Insert Shift:=xlDown sh1.Range("A2:E2").Value = sh2.Range("H2:L2").Value sh1.Range("F2") = Format(Now, "dd/mm/yyyy h:mm;@") sh1.Range("G2") = sh2.Name sh1.Rows(3).Copy sh1.Rows(2).PasteSpecial Paste:=xlPasteFormats Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
[/vba] (проще, быстрее, а главное - без использования буфера обмена)
И дату я бы не стал хранить, как текст... Вдруг ему потом понадобится фильтр за период?... Короче, у меня бы получилось как-то так
[vba]
Код
Sub add_() Application.ScreenUpdating = False Dim sh As Worksheet Set sh = ThisWorkbook.Sheets("МО ЭЗ к Р1") With ThisWorkbook.Sheets("Распечатанные заявления").Range("A2:G2") .EntireRow.Insert .AutoFill .Rows(0).Resize(2), xlFillFormats With .Rows(0) .Value = sh.Range("H2:L2").Value .Cells(7) = sh.Name .Cells(6) = Now 'Format$(Now, "dd/mm/yyyy h:mm") End With End With Application.ScreenUpdating = True End Sub
[/vba] (проще, быстрее, а главное - без использования буфера обмена)
И дату я бы не стал хранить, как текст... Вдруг ему потом понадобится фильтр за период?... Короче, у меня бы получилось как-то так
[vba]
Код
Sub add_() Application.ScreenUpdating = False Dim sh As Worksheet Set sh = ThisWorkbook.Sheets("МО ЭЗ к Р1") With ThisWorkbook.Sheets("Распечатанные заявления").Range("A2:G2") .EntireRow.Insert .AutoFill .Rows(0).Resize(2), xlFillFormats With .Rows(0) .Value = sh.Range("H2:L2").Value .Cells(7) = sh.Name .Cells(6) = Now 'Format$(Now, "dd/mm/yyyy h:mm") End With End With Application.ScreenUpdating = True End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
