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