如何避免将重复的Range从一个工作表粘贴到另一个工作表

Question

我想将数据从名为“ copySheet”的工作表复制到名为“ pasteSheet”的表的第一空白行。

如果copySheet的单元格A2中的数据在pasteSheet的第一列中，则提供错误消息“数据已存在并且避免粘贴”，否则将复制范围从copySheet粘贴到pasteSheet。

我编写了以下代码，但是，IF循环无法正常工作。在pasteSheet第一栏中找到的A2单元格中的值，但是代码忽略了循环并再次粘贴了范围。

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标记这些错误
• avoid 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