Kopieren wenn Daten übereinstimmen

Bild

Betrifft: Kopieren wenn Daten übereinstimmen
von: Manuel
Geschrieben am: 18.11.2015 14:36:39

Hallo!
Wäre super wenn ihr mir kurz helfen könntet. Ich versuche mit unten stehenden Makro Daten von einer Spalte in die andere zu übertragen, jedoch nur wenn das Suchkriterium in der Zeile steht. Dies funktioniert soweit auch, allerdings habe ich das Problem, dass die Werte auch in Zeilen eingefügt werden, wo gar kein Suchkriterium steht. Also der Makro lässt keine Leerzeile, wenn er ein Suchkriterium nicht gefunden hat.

Sub Monate_zusammenzählen_zuordnen()
Dim lnglast As Long
Dim lnglast1 As Long
lnglast = Sheets("Upload_Inventory_Hilfstabelle_p").Cells(Rows.Count, 17).End(xlUp).Row
lnglast1 = Sheets("Upload_Inventory_Hilfstabelle_p").Cells(Rows.Count, 12).End(xlUp).Row
For k = 2 To lnglast
Suchkred = Sheets("Upload_Inventory_Hilfstabelle_p").Cells(k, 17).Value
    For z = 2 To lnglast
    With Sheets("Upload_Inventory_Hilfstabelle_p")
    If .Cells(z, 10).Value = Suchkred Then
    .Cells(z, 18).Value = Cells(z, 11).Value
    'Else
    '.Cells(z, 18).Value = "0"
    End If
    End With
    Next z
Next k
End Sub

WIsst ihr wo mein Fehler liegt?
Grüße,
Manuel

Bild

Betrifft: AW: Kopieren wenn Daten übereinstimmen
von: MCO
Geschrieben am: 19.11.2015 08:41:46
Moin!
Ich hab mal etwas Ordnungn ins Chaos gebracht, allerdings kann ich ohne Tabelle weder die Bedingung noch die Bezüge prüfen.
Bitte Kommentar beachten!
Gruß, MCO

Sub Monate_zusammenzählen_zuordnen()
    Dim lnglast As Long
    Dim lnglast1 As Long
    
    With Sheets("Upload_Inventory_Hilfstabelle_p")
        lnglast = .Cells(Rows.Count, 17).End(xlUp).Row
        lnglast1 = .Cells(Rows.Count, 12).End(xlUp).Row
    
        For k = 2 To lnglast
            Suchkred = .Cells(k, 17).Value
            
            For z = 2 To lnglast
                If .Cells(z, 10).Value = Suchkred And .Cells(z, 10) <> "" Then
                    .Cells(z, 18).Value = Cells(z, 11).Value 'fehlt beim 2ten Bezug absichtlich  _
der Punkt?
                    'Else
                    '.Cells(z, 18).Value = "0"
                End If
            Next z
        Next k
    End With
End Sub


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Kopieren wenn Daten übereinstimmen"