Как экспортировать идентифицированные значения на новый лист?

Это продолжение моего предыдущего вопроса, который можно найти здесь.

Просто для краткого описания, у меня есть эта таблица:

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 

Теперь мне просто нужно выяснить, как экспортировать эти строки в новый лист, и я не знаю, с чего начать.

Обновлен ваш код, чтобы показать, как экспортировать найденные строки на новый лист:

 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 

Почему вы используете цикл в порядке убывания

 For n1 = lastRowcheck To 1 Step -1 For n1 = 1 To lastRowcheck 

в то время как вы можете использовать его, если вам нужен результат в том же порядке, что и данные.

 Sub Export() Dim lastRowcheck As Long, n1 As Long, i As Long Dim ws As Worksheet Set ws = Sheets("NewSheet") 'sheet name to export data i = 2 'add data from row 2 in new sheet With Worksheets("Sheet1") lastRowcheck = Application.Max(.Range("B" & .Rows.Count).End(xlUp).Row, _ .Range("C" & .Rows.Count).End(xlUp).Row) For n1 = 1 To lastRowcheck 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 ws.Cells(i, "A") = .Cells(n1, "A") ws.Cells(i, "B") = .Cells(n1, "B") ws.Cells(i, "C") = .Cells(n1, "C") i = i + 1 End If Next n1 End With 

End Sub

Давайте будем гением компьютера.