Werte übertragen

[lapunta]

Hallo,

ich hab ein Makro geschrieben, das zwei Werte in unterschiedlichen Tabellen miteinander vergleicht und falls die Werte ungleich sind, an der entspr. Stelle eine Leerzeile einfügt. Funktioniert soweit und sieht so aus:

Code:

Dim i As Long, j As Long
Sub WERTsuchen()

    Dim inSpalte As Integer
    Dim string1 As String
    
    inSpalte = 2 'hier steht der Wert drin
    
    i = Cells(Rows.Count, 1).End(xlUp).Row
    Range("C3") = i
    
    For j = 7 To i
    string1 = Worksheets("Tabelle1").Cells(j, 2).Value
    'Cells(j, 7) = string1
      
        If Cells(j, inSpalte) <> string1 Then
            Call Wertanzeigen
        End If
    Next j
End Sub

Public Sub Wertanzeigen()
 Worksheets("Tabelle2").Activate
 
    Range(Cells(j, 1), Cells(i + 1, 4)).Select
    Rows(j).Insert
    
    i = i + 1
    
End Sub

Jetzt soll mir das Makro noch die fehlenden Werte aus Tabelle1 in Tabelle2 übertragen - und das funktioniert nicht.
Die zu übertragenden Daten stehen auf Tabelle1 Im Range

Code:

Range(Cells(j, 1), Cells(j, 4)).Select

Wer kann mir heilfen?

[schauan]

Hallöchen,

Du musst natürlich auch die Daten aus Tabelle1 holen, im Prinzip z.B.

With Sheets("Tabelle1")
.Range(.Cells(j, 1), .Cells(j, 4)).Copy Sheets("Tabelle2").cells(j, 1)
End With

[lapunta]

Danke für die Antwort.
Bin aber bereits selbst darauf gekommen.
Leider funktioniert mein Makro nur ,wenn in der neuen Liste ein neuer Wert steht. Stehen zwei neue Werte hintereinander, funktioniert es nicht, weil der Vergleichswert ja zwei Zeilen weit entfernt.

Habs jetzt mal mit einem anderen Ansatz versucht, funktioniert aber auch nicht. Jetzt weiß ich nicht mehr weiter.

Ich stell mal meinen (murksigen) Code sowie die Tabellen ins Forum und hoffe das mir jemand hilft:

Code:

Dim i As Long, j As Long, k As Long
Dim lorT1 As Long, lorT2 As Long


Sub DatenAbgleich()

Dim string1 As String
Dim string2 As String

lorT1 = Worksheets("Performance").Cells(Rows.Count, 1).End(xlUp).Row
lorT2 = Worksheets("Abfrage").Cells(Rows.Count, 1).End(xlUp).Row
   
Range("F3") = lorT1
Range("G3") = lorT2

   For i = 7 To lorT1
   
   string1 = Worksheets("Abfrage").Cells(i - 2, 2).Value 'Vergleichswert
   
   
   If Cells(i, 2) <> string1 Then
           Call Wertanzeigen
   End If

   
   Next i
   
End Sub

Public Sub Wertanzeigen()
For j = 5 To lorT2
   string2 = Worksheets("Abfrage").Cells(j, 2).Value 'Vergleichswert
   
        If Cells(j, 2) = string2 Then
           Rows(i).Insert
           Sheets("Abfrage").Select
           Range("A" & j - 2, "E" & j - 2).Select
           Selection.Copy
           Sheets("Performance").Select
           Range("A" & j).Select
           ActiveSheet.Paste
        End If
       
Next j

string1 = Worksheets("Abfrage").Cells(i - 2, 2).Value 'Vergleichswert
Range("H3") = string1
End Sub

[Rabe]

Hi,

Ich stell mal meinen (murksigen) Code sowie die Tabellen ins Forum und hoffe das mir jemand hilft

Du hast jetzt schon 45 Beiträge geschrieben und 12 Themen eröffnet, da solltest Du doch langsam gemerkt haben, daß die Helfer mit Bildchen der Tabelle nichts anfangen können/wollen!

Also stelle bitte (D)eine (Beispiel-)Tabelle als Excel-Datei zur Verfügung oder stelle die relevanten Ausschnitte hier dar, siehe die als Wichtige Themen: markierten Forums-Beiträge.
Deine Mustertabelle sollte mindestens etwa 10-15 Datensätze haben, sensible Daten anonymisiert. Vom Aufbau her muss sie aber deinem Original gleichen.
Auch ein Wunschergebnis sollte dargestellt und als solches erkennbar sein.
Die farbigen Texte sind anklickbare Links:

Hier steht, wie es geht:
Beitrag 2 WICHTIG: Arbeitsmappen zur Verfügung stellen
Beitrag 3 WICHTIG: Tabellenausschnitte und VBA-Codes im Forum einstellen

Eine Bitte:
Anstatt Screenshots ist eine Datei oder ein Ausschnitt besser!
"Du gehst ja auch nicht in die Werkstatt und gibst ein Foto Deines kaputten Autos ab!"

[schauan]

Hallo Ralf,
Das Makro macht glaube einen zeilenweisen vergleich. Wenn es nun um mehrere Zeilen geht, muss man den Makroablauf abändern. Die Bilder sind beschreibendes Beiwerk. Mit einer Datei hätte man Daten zum testen.
Ich kann nur am Smartphone nichts programmieren..