Filtre entre 2 dates sur plusieurs a afficher sur lisbox

Bonjour à tous,

Je vous remercie d'avance de votre aide. Je souhaite effectuer un filtre sur plusieurs mois. mais il se trouve que je ne peux faire de filtre que sur 1 mois pas sur 2 ou 3 mois. Au besoin voici le code

Sub show_Sale_Purchase_Data()

Application.ScreenUpdating = False

Dim sp_sh As Worksheet
Set sp_sh = ThisWorkbook.Sheets("Sale_Purchase")

Dim spd_sh As Worksheet
Set spd_sh = ThisWorkbook.Sheets("Sale_Purchase_Display")

sp_sh.AutoFilterMode = False
spd_sh.AutoFilterMode = False
spd_sh.UsedRange.ClearContents

''''' Copie données de la feuille Sale_Purchase à la feuille Sale_Purchase_Display

sp_sh.Range("G:G").NumberFormat = "DD/MM/YYYY"
sp_sh.Range("E:F").NumberFormat = "#,##0"
sp_sh.Range("D:D").NumberFormat = "#,##0"

sp_sh.UsedRange.AutoFilter 7, ">=" & Me.txt_Start_Date.Value, xlAnd, "<=" & Me.txt_End_Date.Value

If Me.OptionButton2.Value = True Then ''' Filtre Achat
sp_sh.UsedRange.AutoFilter 3, "Achat"
End If

If Me.OptionButton3.Value = True Then ''' Filtre Vente
sp_sh.UsedRange.AutoFilter 3, "Vente"
End If

sp_sh.UsedRange.Copy
spd_sh.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats

sp_sh.AutoFilterMode = False

'''''''''' Afficher données dans la listbox
Dim lr As Long
lr = Application.WorksheetFunction.CountA(spd_sh.Range("A:A"))

If lr = 1 Then lr = 2

On Error Resume Next
With Me.ListBox2

ListBox2.RowSource = "Sale_Purchase_Display!A2:I" & lr
End With
End Sub

Merci encore de votre aide