比较两个数据区域并将整行复制到工作表VBA中

Sub CompareAndCopyRows()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim dataRange1 As Range, dataRange2 As Range
    Dim cell As Range, copyRange As Range
    
    ' 设置工作表
    Set ws1 = ThisWorkbook.Worksheets("Sheet1") ' 原始数据工作表
    Set ws2 = ThisWorkbook.Worksheets("Sheet2") ' 比较数据工作表
    
    ' 设置数据区域范围
    Set dataRange1 = ws1.Range("A1:A10") ' 原始数据区域范围
    Set dataRange2 = ws2.Range("A1:A10") ' 比较数据区域范围
    
    ' 遍历原始数据区域
    For Each cell In dataRange1
        ' 检查是否在比较数据区域中存在相同的值
        If Application.WorksheetFunction.CountIf(dataRange2, cell.Value) > 0 Then
            ' 将整行复制到工作表中
            If copyRange Is Nothing Then
                Set copyRange = cell.EntireRow
            Else
                Set copyRange = Union(copyRange, cell.EntireRow)
            End If
        End If
    Next cell
    
    ' 将复制的数据粘贴到工作表VBA中
    If Not copyRange Is Nothing Then
        copyRange.Copy ws2.Range("V1")
    End If
    
    ' 清除剪贴板
    Application.CutCopyMode = False
    
    MsgBox "完成复制数据到工作表VBA中！", vbInformation
End Sub