VBA - 从 A 列和 B 列复制单元格并粘贴到新工作表中

Question

跟进上一篇文章中的问题：

VBA - Compare Column on Previous Report With New Report to Find New Entries

下面的解决方案将上周生成的报告与本周生成的报告进行比较，并在 A 列中找到两者之间的差异。然后将 A 列中的差异复制到 A 列的新工作表中。但是，范围略有变化，因为我需要从原始工作表中复制 A 列和 B 列中相邻单元格的差异。

例如：

A 列包含用户 ID，B 列包含员工姓名

对用户 ID 进行比较，当发现差异时，将该特定用户 ID 复制到新工作表中。但是，我需要将用户 ID 和员工姓名复制到新工作表中，而不仅仅是用户 ID。

我无法复制整行，因为其他列中有其他信息对于报告摘要来说不是必需的。

这是Vityata提供的代码：

    Public Sub FindDifferences()

        Dim firstRange As Range
        Dim secondRange As Range

        Dim wks1 As Worksheet: Set wks1 = Worksheets(1)
        Dim wks2 As Worksheet: Set wks2 = Worksheets(2)
        Dim wks3 As Worksheet: Set wks3 = Worksheets(3)

        Set firstRange = wks1.UsedRange
        Set secondRange = wks2.UsedRange

        Dim myCell  As Range

        For Each myCell In firstRange
            If myCell <> secondRange.Range(myCell.Address) Then
                wks3.Range(myCell.Address) = myCell
            End If
        Next myCell

    End Sub

这是我目前的代码：

Public Sub FindDifferences()

    Dim firstRange As Range
    Dim secondRange As Range
    Dim myCell As Range

    Dim wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet

    'Find Removed Wintel Servers
    Set wks1 = ActiveWorkbook.Sheets("sh1")
    Set wks2 = ActiveWorkbook.Sheets("sh2")
    Set wks3 = ActiveWorkbook.Sheets("sh3")

    Set firstRange = Range(wks1.Range("A1"), wks1.Range("A" & Rows.Count).End(xlUp))
    Set secondRange = Range(wks2.Range("A1"), wks2.Range("A" & Rows.Count).End(xlUp))

    For Each myCell In secondRange
        If WorksheetFunction.CountIf(firstRange, myCell) = 0 Then

            myCell.Copy
            wks3.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            wks3.Cells(Rows.Count, 1).End(xlUp).PasteSpecial xlPasteFormats

        End If
    Next myCell

wks3.Range("A1").Select

End Sub

Answer 1

这可能不是最简单的方法，但它对我有用。如果您需要我解释不同的变量，请告诉我。
该代码假定您在每张纸的第一行都有标题。

Sub FindDifferences()

    Dim LastRow As Integer
    Dim LastRow2 As Integer
    Dim rng As Range
    Dim rng2 As Range
    Dim rng3 As Range
    Dim rng4 As Range
    Dim Counter As Integer
    Dim Counter2 As Integer


    Dim wks1 As Worksheet: Set wks1 = Worksheets(1)
    Dim wks2 As Worksheet: Set wks2 = Worksheets(2)
    Dim wks3 As Worksheet: Set wks3 = Worksheets(3)

        LastRow = wks1.Cells(Rows.Count, "A").End(xlUp).Row
        LastRow2 = wks2.Cells(Rows.Count, "A").End(xlUp).Row
        Set rng = wks1.Range("A2")
        Set rng2 = wks1.Range("A2:B2")
        Set rng3 = wks2.Range("A2:A" & LastRow2)
        Set rng4 = wks3.Range("A2:B2")
        Counter = 2
        Counter2 = 2

    For x = 1 To LastRow

        Set ValueCheck = rng3.Find(rng.Value, LookIn:=xlValues)

        If ValueCheck Is Nothing Then
        rng2.Copy _
        Destination:=rng4
        Counter2 = Counter2 + 1
        End If

        Counter = Counter + 1
        Set rng = wks1.Range("A" & Counter)
        Set rng2 = wks1.Range("A" & Counter & ":B" & Counter)
        Set rng4 = wks3.Range("A" & Counter2 & ":B" & Counter2)

    Next x

End Sub

Answer 2

在您当前的代码中，您可以替换您的行

        myCell.Copy

有了这个：

.Range(myCell.Address & ":" & myCell.Offset(0,1).Address).Copy

我相信这可以正常工作，我没有正确测试，如果您遇到错误，请告诉我，我会试用它