Excel VBA Макросы: Чем заменить Activate?

Автор Alejo, 04 октября 2018, 20:46

Alejo

Хочу написать макрос для переноса большого количества данных (примерно 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

Alejo