Join Several VBA Codes together

[thedeadzeds]

Hi Guys, Just wondering if there is a way to turn the below 3 codes into one. I have 15 of these in total (3 is just for example purposes). The code essentially filters based on 3 columns, selects the number of rows based on a cell in the 'Allocate' tab and then copies to the 'All Data' Tab.

Each one filters the relevant person in column 16 and copies the amount of rows based on the relevant cell in the 'Allocate Tab' ie

[COLOR=#574123]If i = Range("Allocate!e4").Value + 1 Then Exit Sub[/COLOR]

. For the first person it copies the header and the amount of rows. All others just copy the data and pastes to the next row in the 'All Data' tab. I'm thinking its probably not possible to put all of these in one code but thought i would check.

Many thanks

Sub Bethan_Mason_New_Calls_Service_and_MOT()'Bethan Mason
    Application.ScreenUpdating = False
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim i As Long, j As Long
    Set sh1 = Sheets("Audi SMOT NC Values")
    Set sh2 = Sheets("All Data")
    
    'Filter New Call
    Sheets("Audi SMOT NC Values").Select
    ActiveSheet.Range("$A$1:$P$5000").AutoFilter Field:=4, _
        Criteria1:="New Calls"
    'Filter the relevant Contcode
    ActiveSheet.Range("$A$1:$P$5000").AutoFilter Field:=13, _
        Criteria1:=Array("Kerridge MOT", "Kerridge Service & MOT", "Non Fran Service & MOT", "Non Fran Service", "Polk MOT", _
        "Polk Service & MOT", "Polk Service", "React MOT", "React Service & MOT", "React Service", "MOT", "Service", "Kerridge Service"), Operator:=xlFilterValues
    'Filter by person
    ActiveSheet.Range("$A$1:$P$5000").AutoFilter Field:=16, _
        Criteria1:=Array("Bethan Mason")
        
    i = 1
    For j = 1 To Rows.Count
        If sh1.Cells(j, 1).EntireRow.Hidden = False Then
            
            sh1.Cells(j, 1).EntireRow.Copy sh2.Cells(i, 1)
            i = i + 1
            If i = Range("Allocate!e3").Value + 2 Then Exit Sub
        End If
    Next j
    Application.ScreenUpdating = True
    
End Sub


Sub Angela_Rose_New_Calls_Service_and_MOT()
'Angela Rose
    Application.ScreenUpdating = False
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim i As Long, j As Long
    Set sh1 = Sheets("Audi SMOT NC Values")
    Set sh2 = Sheets("All Data")
    
    'Filter New Call
    Sheets("Audi SMOT NC Values").Select
    ActiveSheet.Range("$A$1:$P$5000").AutoFilter Field:=4, _
        Criteria1:="New Calls"
    'Filter the relevant Contcode
    ActiveSheet.Range("$A$1:$P$5000").AutoFilter Field:=13, _
      Criteria1:=Array("Kerridge MOT", "Kerridge Service & MOT", "Non Fran Service & MOT", "Non Fran Service", "Polk MOT", _
        "Polk Service & MOT", "Polk Service", "React MOT", "React Service & MOT", "React Service", "MOT", "Service", "Kerridge Service"), Operator:=xlFilterValues
    'Filter by person
    ActiveSheet.Range("$A$1:$P$5000").AutoFilter Field:=16, _
        Criteria1:=Array("Angela Rose")
        
   i = 1
    For j = 1 To Rows.Count
        If sh1.Cells(j, 1).EntireRow.Hidden = False Then
            
            sh1.Cells(j, 1).EntireRow.Copy sh2.Cells(i, 1)
            i = i + 1
        
            
            If i = Range("Allocate!e2").Value + 1 Then Exit Sub
        End If
    Next j
    Application.ScreenUpdating = True
    
End Sub


Sub Chloe_Whitfield_New_Calls_Service_and_MOT()
'Chole_Whitfield
    Application.ScreenUpdating = False
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim i As Long, j As Long
    Set sh1 = Sheets("Audi SMOT NC Values")
    Set sh2 = Sheets("All Data")
    
    'Filter New Call
    Sheets("Audi SMOT NC Values").Select
    ActiveSheet.Range("$A$1:$P$5000").AutoFilter Field:=4, _
        Criteria1:="New Calls"
    'Filter the relevant Contcode
    ActiveSheet.Range("$A$1:$P$5000").AutoFilter Field:=13, _
        Criteria1:=Array("Kerridge MOT", "Kerridge Service & MOT", "Non Fran Service & MOT", "Non Fran Service", "Polk MOT", _
        "Polk Service & MOT", "Polk Service", "React MOT", "React Service & MOT", "React Service", "MOT", "Service", "Kerridge Service"), Operator:=xlFilterValues
    'Filter by person
    ActiveSheet.Range("$A$1:$P$5000").AutoFilter Field:=16, _
        Criteria1:=Array("Chloe Whitfield")
        
    i = 1
    For j = 2 To Rows.Count
        If sh1.Cells(j, 1).EntireRow.Hidden = False Then
            
            sh1.Cells(j, 1).EntireRow.Copy
            sh2.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
        
            
            i = i + 1
            If i = Range("Allocate!e4").Value + 1 Then Exit Sub
        End If
    Next j
    Application.ScreenUpdating = True
    
End Sub

 

[Fluff]

Maybe

Sub New_Calls_Service_and_MOT() 'Payam Naeini
    Application.ScreenUpdating = False
    Dim sh1 As Worksheet, sh2 As Worksheet
    Dim i As Long, j As Long, k As Long
    Dim Ary As Variant
    
    Ary = Array("Bethan Mason", "Angela Rose", "Chloe Whitfield")
    Set sh1 = Sheets("Audi SMOT NC Values")
    Set sh2 = Sheets("All Data")
    
    i = 2
    If Sheets("Allocate").Range("E16").Value = "" Then Exit Sub
    For k = 0 To UBound(Ary)
      'Filter New Call
      Sheets("Audi SMOT NC Values").Select
      ActiveSheet.Range("$A$1:$P$5000").AutoFilter Field:=4, _
          Criteria1:="New Calls"
      'Filter the relevant Contcode
      ActiveSheet.Range("$A$1:$P$5000").AutoFilter Field:=13, _
          Criteria1:=Array("Kerridge MOT", "Kerridge Service & MOT", "Non Fran Service & MOT", "Non Fran Service", "Polk MOT", _
          "Polk Service & MOT", "Polk Service", "React MOT", "React Service & MOT", "React Service", "MOT", "Service", "Kerridge Service"), Operator:=xlFilterValues
      'Filter by person
      ActiveSheet.Range("$A$1:$P$5000").AutoFilter Field:=16, _
          Criteria1:=Ary(k)
          
      For j = 2 To Rows.Count
          If sh1.Cells(j, 1).EntireRow.Hidden = False Then
              
              sh1.Cells(j, 1).EntireRow.Copy
              sh2.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
          
              
              i = i + 1
              If i = Range("Allocate!e16").Value + 1 Then Exit Sub
          End If
      Next j
   Next k
    Application.ScreenUpdating = True
    
End Sub