Boa noite, galera do fórum.

Me deparei com o seguinte problema, tenho uma base de dados onde realizo filtro em uma determinada coluna.
Essa coluna recebe valores de data, o que estou tentando realizar é a exportação destes dados conforme o filtro realizado.

Exemplo
Filtro esta selecionado Janeiro, exportar os dados referente a Janeiro.

O código que estou utilizando:

Sub Exportar_xls()

Dim Count, CountLocal As Integer
Dim fApp As Excel.Application
Dim fBook As Excel.Workbook
Dim fSheet As Excel.Worksheet
Dim Arquivo As String
Dim Resultado As VbMsgBoxResult
Dim UltimoRegistro As Integer

    Application.ScreenUpdating = False
    
        Arquivo = Application.GetSaveAsFilename(InitialFileName:="CatMV_", _
            FileFilter:="Pasta de Trabalho do Excel 97-2003 (*.xls), *.xls", _
            Title:="Especifique o nome do arquivo")
            
        If LCase(Arquivo) = "falso" Then Exit Sub
           
        Count = 9
        CountLocal = 4
       
        Set fApp = CreateObject("Excel.Application")
        Set fBook = fApp.Workbooks.Add
    
        Set fSheet = fApp.ActiveWorkbook.Sheets.Add
        fSheet.Name = "Export"
        fApp.Visible = False
        fSheet.Visible = False
        
               
                With fSheet                    
                    .Range("A" & 4).Value = "Id"
                    .Range("B" & 4).Value = "Data"
                    .Range("C" & 4).Value = "Total"
                    .Range("D" & 4).Value = "Total_Somado"
                End With
                
                While Not IsEmpty(Plan2.Range("C" & Count))
            
                    CountLocal = CountLocal + 1
                    
                        With fSheet
                             .Range("A" & CountLocal).Value = Plan2.Range("C" & Count).Value
                             .Range("B" & CountLocal).Value = Plan2.Range("E" & Count).Value
                             .Range("C" & CountLocal).Value = Plan2.Range("K" & Count).Value
                             .Range("D" & CountLocal).Value = Replace(Replace(Plan2.Range("L" & Count).Value, "mv", ""), "nan", "")
                        End With
                         
                    Count = Count + 1
                    
                Wend
    
            fSheet.SaveAs Arquivo
            
            fApp.Workbooks.Close
            fApp.Quit
       
        Set fSheet = Nothing
        Set fBook = Nothing
        Set fApp = Nothing
    
    Application.ScreenUpdating = True
        
End Sub

Gostaria de uma ajuda dos senhores para resolver esse problema, vale lembrar que qualquer ideia sempre é bem vinda.