Хочу написать макрос для переноса большого количества данных (примерно 3700 значений) и с вероятностью 100% упрусь в ошибку "Procedure too large". Придется создавать несколько макросов. И дабы уменьшить кол-во таких макросов назрел вопрос: можно ли сократить кол-во строк при копировании и переносе значения ячейки и избавиться от "Activate"?
Макрос
Sub Svod()
With Application
.ScreenUpdating = False 'отключение обновления экрана
.Application.EnableEvents = False 'отключение обработки событий
.DisplayAlerts = False 'отключение запросов программы
.Calculation = xlManual 'отключение автоматического расчета ячеек
.DisplayStatusBar = False 'отключение отображения значений в статусной строке
ActiveSheet.DisplayPageBreaks = False 'отключение отображения границ страниц
Workbooks("Вышний Волочек.xlsx").Sheets("ПС Труд").Activate
i = Cells(103, 3).Value
Cells(4, i).Copy
Workbooks("Тверьэнерго. Максимальные загрузки тр-ров.xlsm").Activate
Cells(8, 10).PasteSpecial Paste:=xlPasteValues
Workbooks("Вышний Волочек.xlsx").Activate
Cells(7, i).Copy
Windows("Тверьэнерго. Максимальные загрузки тр-ров.xlsm").Activate
Cells(8, 11).PasteSpecial Paste:=xlPasteValues
Workbooks("Вышний Волочек.xlsx").Activate
Cells(8, i).Copy
Windows("Тверьэнерго. Максимальные загрузки тр-ров.xlsm").Activate
Cells(8, 12).PasteSpecial Paste:=xlPasteValues
Workbooks("Вышний Волочек.xlsx").Activate
Cells(100, i).Copy
Workbooks("Тверьэнерго. Максимальные загрузки тр-ров.xlsm").Activate
Cells(8, 13).PasteSpecial Paste:=xlPasteValues
ActiveSheet.DisplayPageBreaks = True 'включение отображения границ страниц
.DisplayStatusBar = True 'включение отображения значений в статусной строке
.Calculation = xlAutomatic 'включение автоматического расчета ячеек
.Application.EnableEvents = True 'включение обработки событий
.DisplayAlerts = True 'включение запросов программы
.ScreenUpdating = True 'включение обновления экрана
End With
End Sub
[вложение удалено администратором]
Макрос
Sub Svod()
Dim sh_voloch As Worksheet, sh_tver As Worksheet
Dim c As Long
Application.ScreenUpdating = False 'отключение обновления экрана
Application.Application.EnableEvents = False 'отключение обработки событий
Application.DisplayAlerts = False 'отключение запросов программы
Application.Calculation = xlManual 'отключение автоматического расчета ячеек
Application.DisplayStatusBar = False 'отключение отображения значений в статусной строке
ActiveSheet.DisplayPageBreaks = False 'отключение отображения границ страниц
' Присваиваем листам, с которыми надо работать, имена.
' Затем в макросе будем обращаться к листам по этим именам.
' Это позволит не использовать 'Activate', т.к. для вашей задачи
' в активации нет необходимости.
Set sh_voloch = Workbooks("Вышний Волочек.xlsx").Sheets("ПС Труд")
Set sh_tver = Workbooks("Тверьэнерго. Максимальные загрузки тр-ров.xlsm").Worksheets("Макс.нагр тр-ров")
c = sh_voloch.Cells(103, 3).Value
sh_tver.Cells(8, 10).Value = sh_voloch.Cells(4, c).Value
sh_tver.Cells(8, 11).Value = sh_voloch.Cells(7, c).Value
sh_tver.Cells(8, 12).Value = sh_voloch.Cells(8, c).Value
sh_tver.Cells(8, 13).Value = sh_voloch.Cells(100, c).Value
ActiveSheet.DisplayPageBreaks = True 'включение отображения границ страниц
Application.DisplayStatusBar = True 'включение отображения значений в статусной строке
Application.Calculation = xlAutomatic 'включение автоматического расчета ячеек
Application.Application.EnableEvents = True 'включение обработки событий
Application.DisplayAlerts = True 'включение запросов программы
Application.ScreenUpdating = True 'включение обновления экрана
End Sub
Обсуждения макроса из ответа 1.
Этот пункт нужно изменить, т.к. он работает с активным листом. У вас макрос работает с двумя листами и не понятно, к какому листу этот пункт надо применить, т.е. непонятная ситуация:
ActiveSheet.DisplayPageBreaks