vba - 如何将识别的值导出到新工作表？

Question

这是我之前的问题的后续，可以找到 here

只是为了快速回顾一下，我有这张表:

ID  Age Grade
1   14  90
2   15  78
3   14  90
4   16  86
5   16  86
6   15  89
7   14  88

我在新工作表中想要的输出表是:

ID  Age Grade
1   14  90
3   14  90
4   16  86
5   16  86

我浏览并挑选出 B 列中具有重复值的行 和 C列使用这个:

Sub Export()

Dim lastRowcheck As Long, n1  As Long

With Worksheets("Sheet1")
    lastRowcheck = Application.Max(.Range("B" & .Rows.Count).End(xlUp).Row, _
                                   .Range("C" & .Rows.Count).End(xlUp).Row)

    For n1 = lastRowcheck To 1 Step -1
        If Application.CountIfs(.Columns("B"), .Cells(n1, "B").Value2, .Columns("C"), .Cells(n1, "C").Value2) > 1 Then
           Debug.Print .Cells(n1, "A") & ":" & .Cells(n1, "B") & ":" & .Cells(n1, "C")
           '''export to new sheet
        End If
    Next n1
End With

End Sub

现在我只需要弄清楚如何将这些行导出到新工作表中，我不知道从哪里开始。

Answer 1

更新了您的代码以显示如何将找到的行导出到新工作表:

Sub Export()

Dim lastRowcheck As Long, n1  As Long
Dim rCopy As Range

With Worksheets("Sheet1")
    lastRowcheck = Application.Max(.Range("B" & .Rows.Count).End(xlUp).Row, _
                                   .Range("C" & .Rows.Count).End(xlUp).Row)

    For n1 = lastRowcheck To 1 Step -1
        If Application.CountIfs(.Columns("B"), .Cells(n1, "B").Value2, .Columns("C"), .Cells(n1, "C").Value2) > 1 Then
           Debug.Print .Cells(n1, "A") & ":" & .Cells(n1, "B") & ":" & .Cells(n1, "C")
           '''export to new sheet
           If rCopy Is Nothing Then Set rCopy = .Rows(n1) Else Set rCopy = Union(rCopy, .Rows(n1))
        End If
    Next n1
End With


With Sheets("Sheet2")                            'For using a sheet that already exists
'With Sheets.Add(After:=Sheets(Sheets.Count))    'For creating a brand new sheet to use
    If Not rCopy Is Nothing Then rCopy.EntireRow.Copy _
        Destination:=.Cells(.Rows.Count, "A").End(xlUp).Offset(1)
End With

End Sub