Automatically move an entire row of expired item from one sheet to another sheet

Hi,

I have a problem with the code below. I am a store officer in the firm I am currently with, and monitory of expiring date of a product is part of my daily routine.

I have been able to use excel (if function and conditional formatting) to create an automated expiring alert that gives me alert from eight month to the expiring date of the product.

Furthermore, I want to programme the alert I have created to automatically move entire row of every expired item from one sheet to another sheet that's from sheet1 (alert) to sheet3 (expired) without manually cutting and paste from one sheet to another each time an item get expired.

I tried these codes but I can't seem to have my way around it.

I am just typing below how the format on the sheet 1(Alert) looks like and also uploaded a picture of the sheet.

I am very grateful for your help!

A B C D
RECEIVED DATE RECEIVED FROM MEDICINES BATCH NUMBER
E F G H
QUANTITY RECEIVED EXPIRING DATE DAYS LEFT STATUS
I
LOCATION
December 5, 2018 PARA 25mg PARA 25MG 10 100 Monday, October 1, 2018 -89 EXPIRED

Sub TransferExpired()
    Dim h As Range, TransferRange As Range, DataRange As Range
    Dim DestRange As Range
    Dim Lr As Long
    Dim iCount As Long
With ThisWorkbook
              With .Sheets("ALERT")
  Lr = Sheets("ALERT").Range("A" & Rows.Count).End(xlUp).Row
Set DataRange = ALERT.Range("A3:A" & Lr + 1)
            End With

With .Sheets("EXPIRED")
Lr = Sheets("EXPIRED").Range("A" & Rows.Count).End(xlUp).Row + 1
Set DataRange = EXPIRED.Range("A2:A" & Lr + 1)
DataRange.EntireRow.Hidden = False


For Each h In DataRange.Cells
        If IsDate("Monday,October1,2018") Then
            If ("Monday,October1,2018") < Date Then
                If TransferRange Is Nothing Then
                    Set TransferRange = h
                Else
                    Set TransferRange = Union("A3:A17", h)
                End If
                iCount = iCount + 1
            End If
        End If
    Next h
    If Not TransferRange Is Nothing Then
        With TransferRange.EntireRow
            .Copy DestRange
            .Delete
        End With
    End If

    MsgBox iCount & " Expired Records Transferred", 50, "EXPIRED"
End With

End With

End Sub