Excel 2010で、別のシートへのVBAコピー行ID番号に基づいて先にコピーされた除外

Question

1つのシートから行を取り出し、列内の値に基づいて別のシートにコピー（追加）する必要があるExcelブックがあります。以下のコードを使用してこれを達成できますが、このコードを実行するたびに同じ行をもう一度追加します。

Sheet1が常に追加されます。sheet2は、sheet1のすべての行のインクリメンタルログです（列13に「はい」のフラグが付いています）。両方のシートの同じ列で、列1は一意のIDです。

sheet2にまだ表示されていない行だけがコピーされるように、このコードに追加できる方法はありますか。

ここに掲載されている他の質問への回答から、以下のコードを一緒に書きましたが、シート2の行の重複を避ける方法を見つけることはできませんでした。私はVBAで全く進歩していません。助けを前にありがとう。

Sub GasImportToPending() 
    Dim x As Long 
    Dim iCol As Integer 
    Dim MaxRowList As Long 
    Dim S As String 


    Set wsSource = Worksheets("sheet1") 
    Set wsTarget = Worksheets("sheet2") 

    iCol = 1 
    MaxRowList = wsSource.Cells(Rows.Count, iCol).End(xlUp).Row 

    For x = MaxRowList To 1 Step -1 
     S = wsSource.Cells(x, 13) 
     If S = "Yes" Or S = "yes" Then 



      AfterLastTarget = wsTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1 

      wsSource.Rows(x).Copy 
      wsTarget.Rows(AfterLastTarget).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
      End If 
    Next 

    Application.ScreenUpdating = True 

End Sub 

Answer 1

以下を試してください。列Aの一意の識別子を使用し、列Aに存在する場合はSheet2にあります。そうであれば、行をコピーしません。それ以外の場合は行をコピーします。

Sub GasImportToPending() 
    Dim x As Long 
    Dim iCol As Integer 
    Dim MaxRowList As Long 
    Dim S As String 
    Dim fVal As String 
    Dim fRange As Range 


    Set wssource = Worksheets("sheet1") 
    Set wstarget = Worksheets("sheet2") 

    iCol = 1 
    MaxRowList = wssource.Cells(Rows.Count, iCol).End(xlUp).Row 

    For x = MaxRowList To 1 Step -1 
     S = wssource.Cells(x, 13) 
     If S = "Yes" Or S = "yes" Then 

      fVal = wssource.Cells(x, 1).Value 

      Set fRange = wstarget.Columns("A:A").Find(What:=fVal, LookIn:=xlFormulas, LookAt _ 
       :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ 
       False, SearchFormat:=False) 

      If fRange Is Nothing Then 

       AfterLastTarget = wstarget.Cells(Rows.Count, 1).End(xlUp).Row + 1 

       wssource.Rows(x).Copy 
       wstarget.Rows(AfterLastTarget).PasteSpecial Paste:=xlPasteValuesAndNumberFormats 
      End If 

     End If 
    Next 

    Application.ScreenUpdating = True 

End Sub