Как избежать вставки дубликата Range с одного листа на другой

Question

Я хочу скопировать данные из рабочего листа с именем «copySheet» в первую пустую строку на листе с именем «pasteSheet».

Если данные в ячейке A2 copySheet находятся в первом столбце pasteSheet, укажите сообщение об ошибке «данные уже существуют и избегают вставки», в противном случае вставьте диапазон копирования из copySheet в pasteSheet.

Я написал код, как показано ниже, однако, если l oop работает неправильно. Значение в ячейке A2 находится в первом столбце pasteSheet, но код игнорирует l oop и снова вставляет диапазон.

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

Answer 1

Попробуй это. Несколько проблем с вашим кодом:

• , как отмечено выше, ваш синтаксис Columns был выключен
• , вы определили FoundRange, но затем сослались на FoundCell - используйте Option Explicit to отметьте эти ошибки
• по возможности избегайте Select

---

    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