CODEWITHSUNDEEP
excelvbarangecopy-paste
Dhruv Bhatt
Dhruv Bhatt

Reputation: 59

How to avoid pasting duplicate Range from one worksheet to another

I want to copy data from a worksheet named "copySheet" to the first blank row in a sheet named "pasteSheet".

If the data in cell A2 of copySheet is in first column of pasteSheet then provide an error message "data is already existed and avoid pasting" otherwise paste the copy range from copySheet to pasteSheet.

I have written code as below however, IF loop is not working correctly. The value in A2 cell found in first column of pasteSheet but code is ignoring the loop and pastes the range again.

Sub Macro1()
'
' Macro1 Macro
'
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets("Sheet1")
Set pasteSheet = Worksheets("Sheet2")

copySheet.Columns("A:D").Select
Selection.ClearContents

ActiveSheet.Paste Destination:=copySheet.Range("A1")

Dim FoundRange As Range
Dim Search As String
Search = copySheet.Cells(2, 1).Select
Set FoundRange = pasteSheet.Columns(0, 1).Find(Search, LookIn:=xlValues, LookAt:=xlWhole)
If Foundcell Is Nothing Then
    Dim N As Long
    N = copySheet.Cells(1, 1).End(xlDown).Row
    Range("A2:E" & N).Select
    Selection.Copy
    pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Else
    MsgBox "Data Exists" & " data found at cell address " & Foundcell.Address
End If

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub

Upvotes: 0

Views: 117

Answers (1)

SJR
SJR

Reputation: 23081

Try this. A few problems with your code:

  • as noted above, your Columns syntax was off
  • you defined FoundRange but then referred to FoundCell - use Option Explicit to flag up these errors
  • avoid Select wherever possible
    Option Explicit

    Sub Macro1()

    Dim copySheet As Worksheet
    Dim pasteSheet As Worksheet

    Set copySheet = Worksheets("Sheet1")
    Set pasteSheet = Worksheets("Sheet2")

    With copySheet
        .Columns("A:D").ClearContents
        Dim FoundRange As Range
        Dim Search As String
        Search = .Cells(2, 1)
        Set FoundRange = pasteSheet.Columns(1).Find(Search, LookIn:=xlValues, LookAt:=xlWhole)
        If FoundRange Is Nothing Then
            Dim N As Long
            N = .Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Range("A2:E" & N).Copy
            pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Else
            MsgBox "Data Exists" & " data found at cell address " & FoundRange.Address
        End If
    End With

    End Sub

Upvotes: 1

Related Questions