Здравствуйте! Помогите, пожалуйста, написать макрос. Для отправки сметы клиенту нужно удалить из нее все лишние данные (входные цены, наценки, трудозатраты и т.д.) Все данные для клиента выделены областью печати. Вручную я выполняю эту задачу так: 1)Выбираю первую вкладку 2)Выделяю область печати 3) копировать -> вставить значения 4) удалить все данные вне области печати (я выделяю десяток столбцов правее области печати и нажимаю Del) 5) выбираю следующую вкладку, повторяю весь цикл
Очень хочется данный процесс автоматизировать
Здравствуйте! Помогите, пожалуйста, написать макрос. Для отправки сметы клиенту нужно удалить из нее все лишние данные (входные цены, наценки, трудозатраты и т.д.) Все данные для клиента выделены областью печати. Вручную я выполняю эту задачу так: 1)Выбираю первую вкладку 2)Выделяю область печати 3) копировать -> вставить значения 4) удалить все данные вне области печати (я выделяю десяток столбцов правее области печати и нажимаю Del) 5) выбираю следующую вкладку, повторяю весь цикл
Очень хочется данный процесс автоматизироватьAramzamzam
Привет попробуйте так (возьмите на всякий случай копию файла) [vba]
Код
Sub ertert() Dim wsh As Worksheet For Each wsh In ThisWorkbook.Sheets With wsh.Range(wsh.PageSetup.PrintArea) .Value = .Value wsh.Cells(1, .Columns.Count + 1).Resize(, 10).EntireColumn.Delete wsh.Cells(.Rows.Count + 1, 1).Resize(10).EntireRow.Delete End With Next wsh End Sub
[/vba]
Привет попробуйте так (возьмите на всякий случай копию файла) [vba]
Код
Sub ertert() Dim wsh As Worksheet For Each wsh In ThisWorkbook.Sheets With wsh.Range(wsh.PageSetup.PrintArea) .Value = .Value wsh.Cells(1, .Columns.Count + 1).Resize(, 10).EntireColumn.Delete wsh.Cells(.Rows.Count + 1, 1).Resize(10).EntireRow.Delete End With Next wsh End Sub
Да, в вашем файле макрос выполняется. Спасибо! Видимо дело в том, что я макрос сохранил в персональную книгу макросов. Подскажите, пожалуйста, что нужно сделать, чтобы макрос можно было запускать для разных файлов не копируя его каждый раз.
Да, в вашем файле макрос выполняется. Спасибо! Видимо дело в том, что я макрос сохранил в персональную книгу макросов. Подскажите, пожалуйста, что нужно сделать, чтобы макрос можно было запускать для разных файлов не копируя его каждый раз.Aramzamzam
Потому что на некоторых листах не установлена область печати. Вот так попробуйте:
[vba]
Код
Sub ertert() Dim wsh As Worksheet For Each wsh In ActiveWorkbook.Sheets If Len(wsh.PageSetup.PrintArea) Then With wsh.Range(wsh.PageSetup.PrintArea) .Value = .Value wsh.Cells(1, .Columns.Count + 1).Resize(, 10).EntireColumn.Delete wsh.Cells(.Rows.Count + 1, 1).Resize(10).EntireRow.Delete End With End If Next wsh End Sub
[/vba]
Но строк и столбцов для удаления м.б. не 10, а сколько угодно. Поэтому вот так будет лучше:
[vba]
Код
Sub ertert22() Dim wsh As Worksheet, cl&, rw& For Each wsh In ActiveWorkbook.Sheets If Len(wsh.PageSetup.PrintArea) Then With wsh.Range(wsh.PageSetup.PrintArea) .Value = .Value cl = wsh.UsedRange.Columns.Count: rw = wsh.UsedRange.Rows.Count If cl > .Columns.Count Then wsh.Cells(1, .Columns.Count + 1).Resize(, cl - .Columns.Count).EntireColumn.Delete If rw > .Rows.Count Then wsh.Cells(.Rows.Count + 1, 1).Resize(rw - .Rows.Count).EntireRow.Delete End With End If Next wsh End Sub
[/vba]
Потому что на некоторых листах не установлена область печати. Вот так попробуйте:
[vba]
Код
Sub ertert() Dim wsh As Worksheet For Each wsh In ActiveWorkbook.Sheets If Len(wsh.PageSetup.PrintArea) Then With wsh.Range(wsh.PageSetup.PrintArea) .Value = .Value wsh.Cells(1, .Columns.Count + 1).Resize(, 10).EntireColumn.Delete wsh.Cells(.Rows.Count + 1, 1).Resize(10).EntireRow.Delete End With End If Next wsh End Sub
[/vba]
Но строк и столбцов для удаления м.б. не 10, а сколько угодно. Поэтому вот так будет лучше:
[vba]
Код
Sub ertert22() Dim wsh As Worksheet, cl&, rw& For Each wsh In ActiveWorkbook.Sheets If Len(wsh.PageSetup.PrintArea) Then With wsh.Range(wsh.PageSetup.PrintArea) .Value = .Value cl = wsh.UsedRange.Columns.Count: rw = wsh.UsedRange.Rows.Count If cl > .Columns.Count Then wsh.Cells(1, .Columns.Count + 1).Resize(, cl - .Columns.Count).EntireColumn.Delete If rw > .Rows.Count Then wsh.Cells(.Rows.Count + 1, 1).Resize(rw - .Rows.Count).EntireRow.Delete End With End If Next wsh End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
