✔ Excel VBA - Vergleichen und am Ende anfügen

[jerry0110]

Hallo zusammen,

ich habe 2 Sheets mit Daten.
Und ich möchte den Sheet 1 mit dem Sheet 2 vergleichen.
In der Spalt A Sheet 2 steht ein Wert der in Spalte A Sheet 1 auch stehen könnte.
Wenn der Wert in Sheet 1 steht, dann soll er nichts machen und wenn er das nicht findet, dann soll er das am Ende des Sheets 1 anfügen.

Das habe ich bis jetzt gemacht. Aber wenn ich alles aus Sheet 1 lösche dann fügt er nichts an.

Sub suche()

    Dim i As Long
    Dim f As Long
    Dim lastrow As Long
    Dim lastrow2 As Long
 
    lastrow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    lastrow2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row

    For i = 4 To lastrow
        For f = 3 To lastrow2
                If Not Worksheets("Sheet1").Range("A" & i).Value = Worksheets("Sheet2").Range("A" & f).Value Then
                    Worksheets("Sheet1").Range("A" & i).Value = Worksheets("Sheet2").Range("A" & f).Value
                    i = i + 1
                End If
        Next
    Next
    
End Sub

 

[Zvoni]

Sub Suche()
Dim i As Long
Dim j As Long
Dim Treffer As Boolean
Dim lastrow1 As Long
Dim lastrow2 As Long

    lastrow2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
    For j = 3 To lastrow2
        Treffer = False
        i = 4
        Do
            If Worksheets("Sheet1").Cells(i, 1) = Worksheets("Sheet2").Cells(j, 1) Then
                Treffer = True
                Exit Do
            End If
            i = i + 1
        Loop Until Worksheets("Sheet1").Cells(i, 1) = ""
        If Not Treffer Then
            lastrow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
            Worksheets("Sheet1").Cells(lastrow1 + 1, 1) = Worksheets("Sheet2").Cells(j, 1)
        End If
    Next

End Sub

 

[jerry0110]

Hi,

ich habe zum testen den Code genommen und gestartet.
Natürlich angepasst.

Es läuft durch aber trägt keine Daten ein.
Ich habe zum testen die Daten aus liste 1 gelöscht.
Also müsste er ja alle Daten aus Sheet 2 eintragen.
Macht er aber auch nicht.

 

[Zvoni]

In meiner mappe schon
Hatte ich getestet
Zeig mal deinen angepassten code

 

[jerry0110]

Im POP Export Sheet sind alle Daten drin.
Und im Realisierungs Sheet sind die Daten drin wo die Dinge aus der POP Export Liste fehlen könnten.

Option Explicit

Sub Suche()
Dim i As Long
Dim j As Long
Dim Treffer As Boolean
Dim lastrow1 As Long
Dim lastrow2 As Long

lastrow2 = Worksheets("POP Export Bestellungen").Cells(Rows.Count, 1).End(xlUp).Row
   
    For j = 3 To lastrow2
        Treffer = False
        i = 4
        Do
            If Worksheets("Realisierung").Cells(i, 1) = Worksheets("POP Export Bestellungen").Cells(j, 1) Then
                Treffer = True
                Exit Do
            End If
            i = i + 1
        Loop Until Worksheets("Realisierung").Cells(i, 1) = ""
        If Not Treffer Then
            lastrow1 = Worksheets("Realisierung").Cells(Rows.Count, 1).End(xlUp).Row
            Worksheets("POP Export Bestellungen").Cells(j, 1) = Worksheets("Realisierung").Cells(lastrow1 + 1, 1)
        End If
    Next

End Sub

 

[Zvoni]

Zeile 24.
Verkehrt herum

 

[jerry0110]

Zeile 24.
Verkehrt herum

Hat alles geklappt. Danke