Copy data from one worksheet to another based on date

I am using Ron De Bruin's macro shown below to copy data from one worksheet to another and it works well until the operator has a problem, runs the macro again, and the data gets copied twice, then I have duplicate data. What I need to know, can the code be adapted or a new macro to only copy today's data and if run again it would not add today's data twice to the other worksheet.

Is this possible? Thank you for your help!

Sub Copy_To_Another_Workbook() 
    Dim SourceRange As Range 
    Dim DestRange As Range 
    Dim DestWB As Workbook 
    Dim DestSh As Worksheet 
    Dim LR As Long 
    Dim rCell As Range 
    Dim rChange As Range 
     
     
     
    With Application 
        .ScreenUpdating = False 
        .EnableEvents = False 
    End With 
     
     'Change the file name (2*) and the path/file name to your file
    If bIsBookOpen_RB("Shipping Manifest Database.xlsm") Then 
        Set DestWB = Workbooks("Shipping Manifest Database.xlsm") 
    Else 
        Set DestWB = Workbooks.Open("G:\CSA\Shipping Data\Shipping Manifest Database.xlsm") 
    End If 
     
     'Change the Source Sheet and range
    Set SourceRange = ThisWorkbook.Sheets("4 PM").Range("I6:N150") 
     'Change the sheet name of the database workbook
    Set DestSh = DestWB.Worksheets("Shipping Data") 
     
    LR = LastRow(DestSh) 
    Set DestRange = DestSh.Range("A" & LR + 1) 
     
     'We make DestRange the same size as SourceRange and use the Value
     'property to give DestRange the same values
    With SourceRange 
        Set DestRange = DestRange.Resize(.Rows.Count, .Columns.Count) 
    End With 
    DestRange.Value = SourceRange.Value 
     
    DestWB.Close savechanges:=True 
     
    With Application 
        .ScreenUpdating = True 
        .EnableEvents = True 
    End With 
End Sub 
Function LastRow(sh As Worksheet) 
    On Error Resume Next 
    LastRow = sh.Cells.Find(What:="*", _ 
    After:=sh.Range("A1"), _ 
    LookAt:=xlPart, _ 
    LookIn:=xlFormulas, _ 
    SearchOrder:=xlByRows, _ 
    SearchDirection:=xlPrevious, _ 
    MatchCase:=False).Row 
    On Error GoTo 0 
End Function 
Function LastCol(sh As Worksheet) 
    On Error Resume Next 
    LastCol = sh.Cells.Find(What:="*", _ 
    After:=sh.Range("A1"), _ 
    LookAt:=xlPart, _ 
    LookIn:=xlFormulas, _ 
    SearchOrder:=xlByColumns, _ 
    SearchDirection:=xlPrevious, _ 
    MatchCase:=False).Column 
    On Error GoTo 0 
End Function 
Function bIsBookOpen_RB(ByRef szBookName As String) As Boolean 
     ' Rob Bovey
    On Error Resume Next 
    bIsBookOpen_RB = Not (Application.Workbooks(szBookName) Is Nothing) 
End Function

I found another code from Ron De Bruin that deletes the entire row if the date equal today so this work for me.

Thanks to everyone who looked at this post and a big thank you to Ron De Bruin for the code shown below, this code and the one on the original post work flawlessly.

Sub Loop_Example2()
    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    Dim CalcMode As Long
    Dim ViewMode As Long

    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    'We use the ActiveSheet but you can replace this with
    'Sheets("MySheet")if you want
    
    With Workbooks("UPS Database.xlsx").Sheets("UPS Data")

        'We select the sheet so we can change the window view
        .Select

        'If you are in Page Break Preview Or Page Layout view go
        'back to normal view, we do this for speed
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView

        'Turn off Page Breaks, we do this for speed
        .DisplayPageBreaks = False

        'Set the first and last row to loop through
        
        Firstrow = 2
        Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row


        'Firstrow = .UsedRange.Cells(1).Row
        'LastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

        'We loop from Lastrow to Firstrow (bottom to top)
        For Lrow = Lastrow To Firstrow Step -1

            'We check the values in the A column in this example
            With .Cells(Lrow, "A")

                If Not IsError(.Value) Then

                    If .Value = Date Then .EntireRow.Delete 'Date example #8/28/2015#
                    'This will delete each row with the Value "ron"
                    'in Column A, case sensitive.

                End If

            End With

        Next Lrow

    End With

    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = CalcMode
    End With

End Sub