Excel VBA AutoFilter adds empty rows

Question

I have modified my Excel Macro, which before went row by row and it now filters the results and copies in bulk. Much more efficient.

The problem I encouter now, the Auto Filter adds Millions of empty rows to the Worksheet and I can't identify why it does so.

CountryCodes is a dictionary which contains the values for the filter. Criteria is looking for rows that contain the entry from the dictionary.

This is the code:

    For Each vall In CountryCodes
    thisWB.Activate
    thisWB.Sheets("Overall Numbers").Activate

    lookfor = CountryCodes.Item(vall)
    rep = Replace(thisWBName, "EMEA", lookfor)

    Set rng = ActiveSheet.Range("A1:Z1")

    FilterField = WorksheetFunction.Match("Host", rng.Rows(1), 0)

    If ActiveSheet.AutoFilterMode = False Then rng.AutoFilter

    rng.AutoFilter Field:=FilterField, Criteria1:="=*" & lookfor & "*", Operator:=xlFilterValues

    Set rng2 = ThisWorkbook.Worksheets("Overall Numbers").Cells.SpecialCells(xlCellTypeVisible)

    rng2.Copy Workbooks(rep).Worksheets("Overall Numbers").Range("A1")

    Workbooks(rep).Save

    thisWB.Activate
    thisWB.Sheets("Overall Numbers").Activate

    Cells.AutoFilter
Next

Answer 1

Tested:

Dim ur As Range
Set ur = ThisWorkbook.Sheets("Overall Numbers").UsedRange

Application.ScreenUpdating = False
filterField = Application.Match("Host", ur.Rows(1), 0)
If Not IsError(filterField) Then

    For Each vall In countryCodes
       rep = Replace(thisWBName, "EMEA", vall)

       ur.AutoFilter Field:=filterField, Criteria1:="=*" & vall & "*"

       'copy visible rows with data only
       ur.SpecialCells(xlCellTypeVisible).Copy

       'paste visible rows with data only
       Workbooks(rep).Worksheets("Overall Numbers").Range("A1").PasteSpecial xlPasteAll
       Workbooks(rep).Save

       ur.AutoFilter
    Next
End If
Application.ScreenUpdating = True