Excel 2010, VBA Kopie Zeile zu einem anderen Blatt ausgeschlossen kopiert zuvor basierend auf ID-Nummer

Question

Ich habe eine Excel-Arbeitsmappe mit einer Anforderung, Zeilen aus einem Blatt und kopieren (append) auf ein anderes Blatt basierend auf dem Wert innerhalb einer Spalte. Ich kann dies mit dem unten stehenden Code erreichen, aber offensichtlich werde ich jedes Mal, wenn ich diesen Code ausführe, dieselben Zeilen erneut anhängen.

date Sheet1 wird ständig hinzugefügt, sheet2 ist ein inkrementelles Protokoll aller Zeilen in sheet1, die in Spalte 13 das Flag Yes haben. Gleiche Spalten auf beiden Blättern, Spalte 1 ist eine eindeutige ID.

Gibt es eine Möglichkeit, diesen Code hinzuzufügen, um sicherzustellen, dass nur Zeilen aus Blatt1 kopiert werden, die nicht bereits in Blatt2 erscheinen.

Ich habe den Code unten zusammen aus einer Antwort auf andere Fragen hier geschrieben, aber kann nicht scheinen, wie man vermeidet, Zeilen in Sheet2 zu duplizieren. Ich bin überhaupt nicht so fortgeschritten mit VBA. Vielen Dank im Voraus für jede Hilfe.

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

Versuchen Sie Folgendes. Es verwendet den eindeutigen Bezeichner in Spalte A und erkennt, ob es in Spalte A unter Sheet2 vorhanden ist. Wenn dies der Fall ist, wird die Zeile nicht kopiert, anderenfalls wird sie ausgeführt.

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