Zellen mit Schleife nach Bedingung kopieren

[Mario0366]

Hallo zusammen,

ich benötige Hilfe bei einem Problem, wo ich nicht so richtig weiter komme.
Ich würde gerne die Mitarbeiter, die im Tabellenblatt Mitarbeiter einem Kunden zugeordnet sind, im Tabellenblatt Abrechnung den gleichen Kunden zuordnen (mit Personal-Nr., Vorname und Nachname). Könnt ihr eventuell weiterhelfen?

Danke und viele Grüße, Mario
  Kunden Mitarbeiter.xlsx (Größe: 16,17 KB / Downloads: 8)

[shift-del]

Moin

Großartig.
Kein Wunschergebnis.
Keine (reale) Versionsangabe.

Also sind alle Lösungen richtig.

Code:

=FILTER(Mitarbeiter!$A$5:$C$14;Mitarbeiter!$D$5:$D$14=$D$2)

[Mario0366]

Hallo shift-del, 

vielen Dank für deine Hilfe. Wenn ich die Formel einfüge, kommt immer "diese Funktion ist ungültig".
Wäre super, wenn du mir noch einen Tipp geben könntest.

Danke und viele Grüße Mario

[steve1da]

Hola,

Code:

=WENNFEHLER(INDEX(Mitarbeiter!A$5:A$14;AGGREGAT(15;6;ZEILE(Mitarbeiter!$A$5:$A$14)-4/(Mitarbeiter!$D$5:$D$14=$D$2);ZEILE(A1)));"")

nach rechts und nach unten kopieren.
Gruß,
steve1da

[Mario0366]

Hi steve1da,

funktioniert super. Ich danke dir sehr. 

Nur noch eine Frage. Habe heute Nacht versucht, dies in VBA umzusetzen. Bekomme in folgender Zeile aber immer den Laufzeitfehler 1004 in der Zeile: 

Code:

shtDest.Cells(nextRow, 1).PasteSpecial xlPasteValues

hier der komplette Code:

Code:

Sub CompareAndCopy()
    Dim shtSource As Worksheet
    Dim shtDest As Worksheet
    Dim i As Long, j As Long
    Dim lastRowSrc As Long, lastRowDst As Long
    Dim matchFound As Boolean
    Dim nextRow As Long

    'Arbeitsblätter zuordnen
    Set shtSource = ThisWorkbook.Worksheets("Mitarbeiter")
    Set shtDest = ThisWorkbook.Worksheets("Abrechnung")

    'Suchen Sie die letzte Zeile im Quellblatt
    lastRowSrc = shtSource.Cells(shtSource.Rows.Count, "D").End(xlUp).Row
    lastRowDst = shtDest.Cells(shtDest.Rows.Count, "D").End(xlUp).Row

    'Schleife durch die Zeilen im Quellblatt
    For i = 1 To lastRowSrc
        matchFound = False
        'Schleife durch die Zeilen im Zielblatt
        For j = 1 To lastRowDst
            'Prüfen Sie, ob der Kundenname übereinstimmt
            If shtSource.Cells(i, 4).Value = shtDest.Cells(j, 4).Value Then
                matchFound = True
                Exit For
            End If
        Next j
        'wenn Übereinstimmung mit Kundennamen gefunden
        If matchFound Then
            'Finde die nächste leere Zeile im Zielblatt
            nextRow = shtDest.Cells(j + 1, 1).End(xlDown).Row + 1
            shtSource.Cells(i, 1).Resize(1, 3).Copy
            shtDest.Cells(nextRow, 1).PasteSpecial xlPasteValues


        End If
    Next i

    MsgBox "Datenabgleich und Kopieren abgeschlossen"
End Sub

 
Ich wünsche dir einen angenehmen Tag. Viele Grüße Mario

[NobX]

Hallo Mario,

hast Du schon versucht es so zu schreiben?

Code:

shtDest.Cells(nextRow, 1).PasteSpecial Paste:=xlPasteValues

Grüße

NobX

[Mario0366]

Hallo NobX,

entschuldige bitte die späte Rückmeldung. Es hat funktioniert. Vielen Dank noch mal für deine Hilfe.

Schönen Abend noch. 
Viele Grüße Mario

[Mario0366]

Hallo zusammen,

Ich hoffe, ihr könnt helfen.
Wie schon beschrieben, habe ich eine Arbeitsmappe mit zwei Tabellenblättern, "Mitarbeiter" und Abrechnung".
Im Tabellenblatt "Mitarbeiter" sind die Mitarbeiter mit Personalnummer erfasst und bestimmten Kunden zugeordnet. Hier kann es auch vorkommen, dass ein Mitarbeiter mehreren Kunden zugeordnet ist.
Nun würde ich gerne folgendes erreichen:

Die Kunden sollen aus dem Tabellenblatt "Mitarbeiter" aus Spalte D in das Tabellenblatt Abrechnung kopiert werden. Dabei ist es wichtig, dass der Kunde im Tabellenblatt "Abrechnung" nur einmal kopiert wird und darunter alle Mitarbeiter, die diesem Kunden zugeordnet sind.

Da mit der Arbeitsmappe mehrere Kollegen arbeiten und Formeln dann immer wieder gelöscht werden, habe ich versucht es in VBA zu lösen. Leider stoße ich hier an meine Grenzen.

Ich habe mir bei dem Code folgendes gedacht:

Die Schleife iteriert durch jede Zeile der Quelltabelle, beginnend bei Zeile 5.
Für jede Zeile wird der Wert in Spalte 4 (Kundenname) ausgelesen und überprüft, ob er bereits im Wörterbuch Kundenliste vorhanden ist.
Falls nicht, wird der Wert hinzugefügt und der Kundenname sowie der Wert in Spalte 5 in der Zieltabelle kopiert.
Dann werde die Formatierungen auf die kopierten Zellen angewendet.
Anschließend werden die restlichen Daten aus der Quelltabelle in die Zieltabelle kopiert.

Nachdem ich "Microsoft Scripting Runtime" in den Verweisen aktiviert habe, läuft der Code ohne Fehlermeldungen durch, kopiert aber bedauerlicherweise nichts.
Könnt Ihr mir eventuell weiterhelfen?

Hier der Code:

Code:

Sub ModKopieren()
    'Variable für die Quelle Tabelle
    Dim sourceSheet As Worksheet
    'Variable für die Ziel Tabelle
    Dim destSheet As Worksheet
    'Variable für die letzte belegte Zeile in Spalte D der Quelle Tabelle
    Dim lastRowSource As Long
    'Variable für die nächste leere Zeile in Ziel Tabelle
    Dim nextEmptyRow As Long
    'Variable für den Namen des Kunden
    Dim customerName As String
    'Variable für eine Liste, die bereits aufgelisteten Kunden enthält
    Dim customerList As Scripting.Dictionary

    ' Quelle Tabelle festlegen
    Set sourceSheet = ThisWorkbook.Worksheets("Mitarbeiter")
    ' Ziel Tabelle festlegen
    Set destSheet = ThisWorkbook.Worksheets("Abrechnung")

    ' Letzte belegte Zeile in Spalte D der Quelle Tabelle suchen
    lastRowSource = sourceSheet.Cells(sourceSheet.Rows.Count, "D").End(xlUp).Row
    ' Nächste leere Zeile in Ziel Tabelle suchen
    nextEmptyRow = destSheet.Cells(destSheet.Rows.Count, 1).End(xlUp).Row + 1

    ' Neue Liste erstellen
    Set customerList = New Scripting.Dictionary

    ' Schleife für jede Zeile von 5 bis letzte belegte Zeile
    For i = 5 To lastRowSource
        ' Kundennamen aus Quelle Tabelle lesen
        customerName = sourceSheet.Cells(i, 4).Value
        ' Prüfen ob der Kundenname noch nicht in der Liste enthalten ist
        If Not customerList.Exists(customerName) Then
            ' Kundennamen zur Liste hinzufügen
            customerList.Add customerName, customerName
            ' Kundennamen in die Ziel Tabelle schreiben
            destSheet.Cells(nextEmptyRow, 1).Value = customerName
            destSheet.Cells(nextEmptyRow, 2).Value = sourceSheet.Cells(i, 5).Value
            ' Formatierung für die Zellen
            With destSheet.Range("A" & nextEmptyRow & ":B" & nextEmptyRow)
                .Font.Bold = True
                .Interior.Color = RGB(135, 206, 255)
            End With
            ' Nächste leere Zeile suchen
            nextEmptyRow = nextEmptyRow + 1
        End If
        ' Daten in Ziel Tabelle schreiben
        destSheet.Cells(nextEmptyRow, 1).Value = sourceSheet.Cells(i, 1).Value
        destSheet.Cells(nextEmptyRow, 2).Value = sourceSheet.Cells(i, 2).Value
        destSheet.Cells(nextEmptyRow, 3).Value = sourceSheet.Cells(i, 3).Value
        nextEmptyRow = nextEmptyRow + 1
    Next i

    MsgBox "Daten wurden erfolgreich kopiert und sortiert!"
   

End Sub

Danke und viele Grüße,

Mario

[derHoepp]

Hallo Mario,

hast du schon versucht, das ganze Mal im Einzelschritt durchzugehen? Dann kannst du bei jeder Codezeile prüfen, ob das geschieht, was du denkst. Im Lokalfenster kannst du dir gleichzeitig anzeigen lassen, welche Variable gerade mit welchem Wert/Objekt belegt ist.

Viele Grüße
derHöpp

[Mario0366]

Hallo derHöpp,

habe den Fehler gefunden. Die Zeile 10001 war nicht leer. Folglich hat er es darunter kopiert.

Danke für deine Hilfe.

Gruß Mario