Как склеить несколько макросов вместе?

Question

У меня есть три макроса, написанные для Excel.Они работают так, как я хотел - но я не хочу делать их отдельно (они исполняются для нескольких файлов).Может ли кто-нибудь помочь мне склеить эти макросы, чтобы облегчить мою работу?

Ниже приведен код, который работает так, как я хочу.Он разбит на три отдельных макроса.

Sub ETAP1()
'
' ETAP1 Makro
'

'
    ActiveSheet.Unprotect
    Cells.Select
    Selection.EntireColumn.Hidden = False
    Range("I12").Select
    ActiveSheet.ShowAllData
    ActiveSheet.ListObjects(1).Range.AutoFilter Field:=10, Criteria1 _
        :="PROGNOZA_05_2019"
End Sub



Sub ETAP2()
'
' ETAP2 Makro
'

'
    Selection.Replace What:="PROGNOZA_05_2019", Replacement:="PROGNOZA_06_2019" _
        , LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat _
        :=False, ReplaceFormat:=False
    'Columns("K:U").Select
    'Selection.EntireColumn.Hidden = True
    ActiveSheet.ListObjects(1).Range.AutoFilter Field:=10, Criteria1 _
        :="PROGNOZA_06_2019"


End Sub

Sub ETAP3()
'
' ETAP3 Makro
'

'
    Columns("K:U").Select
    ActiveWindow.SmallScroll ToRight:=12
    Range("K:U,AZ:BJ,BL:CA,CC:CO,CQ:DC,DE:DQ,DS:EE").Select
    Range("DS1").Activate
    Selection.EntireColumn.Hidden = True
    ActiveSheet.ListObjects("T_BGT_104_2").Range.AutoFilter Field:=136, _
        Criteria1:="1,00"
    ActiveWindow.ScrollColumn = 94
    ActiveWindow.ScrollColumn = 80
    ActiveWindow.ScrollColumn = 63
    ActiveWindow.ScrollColumn = 50
    ActiveWindow.ScrollColumn = 47
    ActiveWindow.ScrollColumn = 38
    ActiveWindow.ScrollColumn = 34
    ActiveWindow.ScrollColumn = 29
    ActiveWindow.ScrollColumn = 26
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 1
    Sheets("A_BGT_104-2").Select
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
    ActiveWorkbook.Save
End Sub

Я бы попросил вас помочь мне объединить эти три макроса в один.

Answer 1

Ваш последний макрос должен начинаться с

Sub ETAP1()

и заканчивается

End Sub

Просто удалите Sub ETAP2(), Sub ETAP3() и End Sub между ними.

Ваш окончательный макрос будет выглядеть так:

Sub ETAP1()
'
' ETAP1 Makro
'

'
    ActiveSheet.Unprotect
    Cells.Select
    Selection.EntireColumn.Hidden = False
    Range("I12").Select
    ActiveSheet.ShowAllData
    ActiveSheet.ListObjects(1).Range.AutoFilter Field:=10, Criteria1 _
        :="PROGNOZA_05_2019"

    Selection.Replace What:="PROGNOZA_05_2019", Replacement:="PROGNOZA_06_2019" _
        , LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat _
        :=False, ReplaceFormat:=False
    'Columns("K:U").Select
    'Selection.EntireColumn.Hidden = True
    ActiveSheet.ListObjects(1).Range.AutoFilter Field:=10, Criteria1 _
        :="PROGNOZA_06_2019"

   Columns("K:U").Select
    ActiveWindow.SmallScroll ToRight:=12
    Range("K:U,AZ:BJ,BL:CA,CC:CO,CQ:DC,DE:DQ,DS:EE").Select
    Range("DS1").Activate
    Selection.EntireColumn.Hidden = True
    ActiveSheet.ListObjects("T_BGT_104_2").Range.AutoFilter Field:=136, _
        Criteria1:="1,00"
    ActiveWindow.ScrollColumn = 94
    ActiveWindow.ScrollColumn = 80
    ActiveWindow.ScrollColumn = 63
    ActiveWindow.ScrollColumn = 50
    ActiveWindow.ScrollColumn = 47
    ActiveWindow.ScrollColumn = 38
    ActiveWindow.ScrollColumn = 34
    ActiveWindow.ScrollColumn = 29
    ActiveWindow.ScrollColumn = 26
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 1
    Sheets("A_BGT_104-2").Select
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
        :=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, _
        AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
    ActiveWorkbook.Save
End Sub

Дополнительно отметьте Как избежать использования Select в Excel VBA , чтобы сделать ваш код чище, быстрее и проще в управлении

Answer 2

Добавьте новую подпрограмму и затем вызовите ETAP1, ETAP2 и ETAP3.

Как показано ниже:

Sub ETAP()
    ETAP1
    ETAP2
    ETAP3
End Sub