XL 2016 code VBA pour faire une extraction automatique de données selon critères

Sub extraction()

Dim reg As VBScript_RegExp_55.RegExp
Dim Match As VBScript_RegExp_55.Match
Dim Matches As VBScript_RegExp_55.MatchCollection

Dim TRes() As Variant
Dim cpt As Long: cpt = 0
ReDim TRes(cpt)

Dim i As Long
    For i = 6 To 185
    ' instanciation
        Set reg = New VBScript_RegExp_55.RegExp
    ' Pattern
        reg.Pattern = "^(44[1-5])|^(44[7-9])"
    ' Code
        Set Matches = reg.Execute(Sheets("Source").Cells(i, 3))
            For Each Match In Matches
                TRes(cpt) = Sheets("Source").Cells(i, 3) 'Match.Value
                cpt = cpt + (i / i)
                ReDim Preserve TRes(cpt)
            Next Match
    Next i
' Resultat
    Sheets("resultat").Cells(8, 2).Resize(UBound(TRes)) = Application.Transpose(TRes)

' Decharge les variables
Set Matches = Nothing
Set Match = Nothing
Set reg = Nothing
Erase TRes
cpt = Empty
i = Empty

End Sub

Private Sub Worksheet_Activate()
    Application.ScreenUpdating = False
    [Tableau2[DONNEES]].NumberFormat = "General"
    Sheets("Source").Columns(4).Insert
    [Tableau2].AutoFilter
    [Tableau2].Offset(, 1).Formula = "=AND(LEFT(c6,3)*1>=442,LEFT(c6,3)*1<=449,LEFT(c6,3)*1<>446)"
    [Tableau2].AutoFilter Field:=2, Criteria1:="TRUE"
    [Tableau2[DONNEES]].SpecialCells(xlCellTypeVisible).Copy Sheets("resultat").[b8]
    Sheets("Source").Columns(4).Delete
End Sub