مشكلة كود ترحيل تواريخ كان يعمل اصبح لا يعمل

Sub FilterMonth()



Dim StartMonth  As String

Dim StartYear As String



Dim StartDate As Date

Dim EndDate As Date



Dim Criterea_1 As String

Dim Criterea_2 As String



On Error GoTo End_Me





StartMonth = SHEET1.Range("H2")

StartYear = SHEET1.Range("I2")



If StartMonth = "" Then

StartDate = DateSerial(StartYear, 1, 1)

EndDate = DateSerial(StartYear + 1, 1, 1)

Else

StartDate = DateSerial(StartYear, StartMonth, 1)

EndDate = DateSerial(StartYear, StartMonth + 1, 1) - 1

End If



Criterea_1 = ">=" & Format(StartDate, "mm/dd/yyyy")

Criterea_2 = "<=" & Format(EndDate, "mm/dd/yyyy")



SHEET1.Range("A3").AutoFilter Field:=1, Criteria1:=Criterea_1, _

Operator:=xlAnd, Criteria2:=Criterea_2



On Error GoTo 0

Exit Sub

End_Me:

MsgBox "There is no data"



End Sub

'++++++++++++++++++++++

Sub all_months()

Dim i%

  For i = 1 To 12

    Sheets("SHEET1").Range("H2") = i

    FilterMonth

'    Type Her your code to copy the data

  Next

End Sub

'+++++++++++++++++++++++++++++++++

Sub how_all()

If Sheets("SHEET1").AutoFilterMode Then

Sheets("SHEET1").Range("a3").AutoFilter

End If

End Sub