Excel VBA: Loop through autofilter criteria to copy and paste to new sheet then save as new file

Question

I am beginner for excel VBA.

I want to use VBA to loop through autofilter criteria in column G( below photo) to copy and paste to new sheet then save as new file with sequence file name.

Below is my code, i know that it can use if else to do but the code will change to very long and difficult to revise, i want to know how to change to use the loop. Thank you very much for your help.

Dim wb As Workbook 
Dim wsw As Worksheet
Dim y As Workbook
Dim lastRow, lastRow2 As Long
Dim readsheetName As String
Dim destsheetName As String
Dim fso As Object, FolDir As String, FileNm As Object, NumStr As Integer, MaxNum As Integer
Dim NewName As String, StrNum As String, MaxStr As String
Dim FolderStr As String 'Object
MaxNum = 1
FolderStr = "Q:\Alan\VBA\CCA\"
'Set fso = CreateObject("scripting.filesystemobject")
'Set FolDir = fso.GetFolder(FolderStr)
FolDir = Dir(FolderStr)

readsheetName = "2011-2019"
destsheetName = "Cable Collection Advices (2)"
Set wb = ThisWorkbook
Set wsw = wb.Sheets(readsheetName)

wsw.Activate

Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Worksheets("Filtered Data").Delete


On Error GoTo 0
Application.DisplayAlerts = True
Application.ScreenUpdating = False
Set wsDest = ThisWorkbook.Sheets.Add(After:= _
         ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
wsDest.Name = "Filtered Data"
MM1
wsw.Range("A1:U1").AutoFilter Field:=7, Criteria1:="296699"
wsw.Range("A1:U1").AutoFilter Field:=14, Criteria1:="Available", Operator:=xlOr, Criteria2:="="
If wsw.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then

wsw.Cells.SpecialCells(xlCellTypeVisible).Copy
wsDest.Activate
wsDest.Range("A1").PasteSpecial xlPasteFormulasAndNumberFormats

wsDest.Columns("N:U").Delete
wsDest.Columns("A:B").Delete
wsDest.Columns("F").Delete
wsDest.Rows(1).Delete
lastRow = wsDest.Range("A" & Rows.Count).End(xlUp).Row
Set SourceRange = wsDest.Range("A1:D" & lastRow)
Set SourceRange2 = wsDest.Range("F1:G" & lastRow)
Set SourceRange3 = wsDest.Range("E1:E" & lastRow)
Set SourceRange4 = wsDest.Range("J1:J" & lastRow)
SourceRange.Copy
Set y = Workbooks.Open("\\SSSSNNMR20\EAS2EAS1\75 ABCDE Engineering\76 CABLE Engineering - General\PE-Test-ABCDE\E_P\02 AB\Alan\VBA\CCA\Cable Collection Advices - 11.xls")
y.Sheets(destsheetName).Range("C8").PasteSpecial xlPasteValues
SourceRange2.Copy
y.Sheets(destsheetName).Range("G8").PasteSpecial xlPasteValues
SourceRange3.Copy
y.Sheets(destsheetName).Range("I8").PasteSpecial xlPasteValues
SourceRange4.Copy
y.Sheets(destsheetName).Range("J8").PasteSpecial xlPasteValues
lastRow2 = wsDest.Range("C" & Rows.Count).End(xlUp).Row
y.Sheets(destsheetName).Range("A8:A" & lastRow2 + 7).Value = Format(Now(), "dd.mm.yyyy")
y.Sheets(destsheetName).Range("B5").Value = Format(Now(), "dd.mm.yyyy")
Application.DisplayAlerts = False
Do While Len(FolDir) > 0
If FolDir Like "Cable Collection Advices - " & "*" & ".xlsx" Then
StrNum = Right(Left(FolDir, 32), 5)
'MsgBox "StrNum" & StrNum
NumStr = CInt(StrNum)
If NumStr > MaxNum Then
MaxNum = NumStr
End If
End If
FolDir = Dir
'Next FileNm
Loop
MaxStr = CStr(Format(MaxNum + 1))
NewName = FolderStr & "Cable Collection Advices - " & MaxStr & ".xlsx"
y.SaveAs Filename:=NewName, FileFormat:=51, CreateBackup:=False
y.Close SaveChanges:=False
ActiveWorkbook.Worksheets("Filtered Data").Delete
wsw.Activate
MM1
Else
MsgBox ("No data")
End If

Sub MM1() 'close all the worksheet autofilter
Dim ws As Worksheet
For Each ws In Worksheets
'ws.AutoFilterMode = ShowAllData
With ws
    If .AutoFilterMode Then
        If .FilterMode Then
        .ShowAllData
        End If
    End If
End With
Next ws
End Sub

Answer 1

Just yesterday I've made a multiple fields filter - it collected the multiple criteria and put the list on another sheet.

1.- creating 2-dimention array Result(a,b) - where a in horizontal dimention and b- vertical dimension of the table write the filtered table into this array 2. - create a user function to put the lines in Result(a,b) that doesn't satisfy criteria to 0 (in my case there were text data, so i used 0, you can use anything you can identify)

Function is like this

Function ArrFilter(ByVal fVal, ByVal ColNbr)'fVal - value to filter, ColNbr - number of column you filter in 

For i = 1 To count7
If CStr(fVal) <> CStr(Result(ColNbr, i)) Then
For j = 1 To count3
Result(j, i) = 0
Next j
End If
Next i

End Function 

3. Put your criteria dimension in a loop if you have array of criteria Criteria() and column 2

   For Each x in Criteria Call ArrFilter(x, 2) Next x

Then you write the result into table, selecting those that are not 0

count=0
For i=b
If Result(2,i)<>0 Then
For j=a
count=count+1
Cells(count,j)=Result(j,i)
Next j
End If 
Next i