識別された値を新しいシートにエクスポートする方法は？

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 

Iを介して行って、Tを使用してカラムB AND列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

新しいシートに見つかった行をエクスポートする方法を示すために、あなたのコードを更新：

あなたが必要な場合は、あなたがそれを使用することができますしながら、順番

For n1 = lastRowcheck To 1 Step -1 

For n1 = 1 To lastRowcheck 

降順でループを使用しているのはなぜ

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 

Answer 2

結果はデー​​タごとと同じです。

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のは