VBA 2列目の重複を見つけ、2行目にエクスポート

Question

私はhereを実行する必要があるの非常に良い例を見つけましたが、私が見つけなければならない重複は2列目にあります。 'ワークシートは2行目から始まります。ソースワークシートに、私は

Class Name Age 
A  John 10 
A  Maria 11 
A  John 12 
B  John 15 
B  Andy 10 
B  John 16 

次持ち、

Class Name Age 
A  John 10 
A  John 12 
B  John 15 
B  John 16 

を次のように重複したワークシートに私はこのコードを変更することができますどのように重複を取得したい例えば

、これを達成する：

Dim wstSource As Worksheet, _ 
    wstOutput As Worksheet 
Dim rngMyData As Range, _ 
    helperRng As Range 

Set wstSource = Worksheets("Source") 
Set wstOutput = Worksheets("Duplicates") 

With wstSource 
    Set rngMyData = .Range("A1:AQ" & .Range("A" & .Rows.Count).End(xlUp).Row) 
End With 
Set helperRng = rngMyData.Offset(, rngMyData.Columns.Count + 1).Resize(, 1) 

With helperRng 
    .FormulaR1C1 = "=if(countif(C1,RC1)>1,"""",1)" 
    .Value = .Value 
    .SpecialCells(xlCellTypeBlanks).EntireRow.Copy Destination:=wstOutput.Cells(1, 1) 
    .ClearContents 
End With 

Answer 1

コメント行を参照

Dim wstSource As Worksheet, _ 
    wstOutput As Worksheet 
Dim rngMyData As Range, _ 
    helperRng As Range 

Set wstSource = Worksheets("Source") 
Set wstOutput = Worksheets("Duplicates") 

With wstSource 
    Set rngMyData = .Range("A1:AQ" & .Range("A" & .Rows.count).End(xlUp).row) 
End With 
Set helperRng = rngMyData.Offset(, rngMyData.Columns.count + 1).Resize(, 1) 

With helperRng 
    .FormulaR1C1 = "=if(countif(C2,RC2)>1,"""",1)" '<--| change references to column 2 
    .Value = .Value 
    .SpecialCells(xlCellTypeBlanks).EntireRow.Copy Destination:=wstOutput.Cells(2, 1) '<--| start pasting from rew 2 
    .ClearContents 
End With