Can I combine these small macros into one big macro?

[surfdoc37]

Hello and apologies for maybe not having the clearest formatting here. I would like to combine several small macros, which sort out some rows from a sheet, copy them, and paste them into a new blank sheet. Because I am lazy I would like to use one macro to perform the task instead of using the six small macros which do work just fine individually. Macros are all basically the same, only the sort criteria changes. In the VBA editor they are separated by a horizontal line if that matters.

_______________________________________________________

Sub make_C_sheet()
'
' make_C_sheet Macro
'

'
Selection.AutoFilter
ActiveSheet.Range("$A$1:$AG$653").AutoFilter Field:=3, Criteria1:="=*C*", _
Operator:=xlAnd
Cells.Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Range("A1").Select
ActiveSheet.Paste
Columns("A:A").ColumnWidth = 18
Range("A1").Select
End Sub
Sub make_1B_sheet()
'
' make_1B_sheet Macro
'

'
Selection.AutoFilter
ActiveSheet.Range("$A$1:$AG$653").AutoFilter Field:=3, Criteria1:="=*1B*", _
Operator:=xlAnd
Cells.Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Range("A1").Select
ActiveSheet.Paste
Columns("A:A").ColumnWidth = 18
Range("A1").Select
End Sub
Sub make_2B_sheet()
'
' make_2B_sheet Macro
'

'
Selection.AutoFilter
ActiveSheet.Range("$A$1:$AG$653").AutoFilter Field:=3, Criteria1:="=*2B*", _
Operator:=xlAnd
Cells.Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Range("A1").Select
ActiveSheet.Paste
Columns("A:A").ColumnWidth = 18
Range("A1").Select
End Sub

Sub make_SS_sheet()
'
' make_SS_sheet Macro
'

'
Selection.AutoFilter
ActiveSheet.Range("$A$1:$AG$653").AutoFilter Field:=3, Criteria1:="=*SS*", _
Operator:=xlAnd
Cells.Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Range("A1").Select
ActiveSheet.Paste
Columns("A:A").ColumnWidth = 18
Range("A1").Select
End Sub
Sub make_3B_sheet()
'
' make_3B_sheet Macro
'

'
Selection.AutoFilter
ActiveSheet.Range("$A$1:$AG$653").AutoFilter Field:=3, Criteria1:="=*3B*", _
Operator:=xlAnd
Cells.Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Range("A1").Select
ActiveSheet.Paste
Columns("A:A").ColumnWidth = 18
Range("A1").Select
End Sub
Sub make_OF_sheet()
'
' make_OF_sheet Macro
'

'
Selection.AutoFilter
ActiveSheet.Range("$A$1:$AG$653").AutoFilter Field:=3, Criteria1:="=*OF*", _
Operator:=xlAnd
Cells.Select
Selection.Copy
Sheets.Add After:=ActiveSheet
Range("A1").Select
ActiveSheet.Paste
Columns("A:A").ColumnWidth = 18
Range("A1").Select
End Sub

_______________________________________________________

I searched and found the following which looks like it might be a macro to run sequential macros. But not sure how to adapt it, or, whether that is better than just having one great big macro.


_______________________________________________________

Sub Run_A_Procedures()
Call ModuleName.ProcedureName
Call ModuleName.A_1001_Prepare_Sheet
Call ModuleName.A_1002_MergeMultipleWorkbooks
Call ModuleName.A_1003_DeleteSheets1
Call ModuleName.A_1004_Rename_Sheet_after_Workbook_Name
End Sub

__________________________________________________________________

Appreciate any assistance!

 

[johnnyL]

Try something like:

Call make_C_sheet
Call make_1B_sheet
Call make_2B_sheet
'etc,

 

[Alex Blakenburg]

See if this does what you are after.

Sub Combined()

    Dim arrCriteria As Variant
    Dim shtMain As Worksheet, shtNew As Worksheet
    Dim rngMain As Range
    Dim lrMain As Long, i As Long
    
    arrCriteria = Array("*C*", "*1B*", "*2B*", "*SS*", "*3B*", "*OF*")
    
    Set shtMain = ActiveSheet
    With shtMain
        lrMain = .Range("A" & Rows.Count).End(xlUp).Row             ' set last row dynamically
        Set rngMain = .Range("A1:AG" & lrMain)
        If .FilterMode Then .ShowAllData                            ' clear any existing filters
    End With
     
    For i = 0 To UBound(arrCriteria)
        rngMain.AutoFilter Field:=3, Criteria1:="=" & arrCriteria(i)
        rngMain.Copy
        
        Sheets.Add After:=ActiveSheet
        Set shtNew = ActiveSheet
        With shtNew
            .Range("A1").PasteSpecial Paste:=xlPasteAll
            .Columns("A:A").ColumnWidth = 18
            .Range("A1").Select
        End With
    Next i
    
    rngMain.AutoFilter Field:=3                                     ' Clear last filter used
                
End Sub

 

[surfdoc37]

Try something like:

Call make_C_sheet
Call make_1B_sheet
Call make_2B_sheet
'etc,

Unsuccessfully attempted:

Sub combo_macro()

Call make_C_sheet
Call make_1B_sheet
Call make_2B_sheet
Call make_SS_sheet
Call make_3B_sheet
Call make_OF_sheet

End Sub

Got: "Compile error: Sub or Function not defined"

 

[johnnyL]

Do you have those subroutines in a different module?