Office: VBA Makro Daten kopieren

Hi zusammen,
ich bräuchte eure Hilfe denn aktuell bin ich am verzweifeln:

Ich brauche ein Makro für das deutsche Excel. Es gibt 2 verschiedene Arbeitsmappen mit jeweils einem aktiven Arbeitsblatt. Arbeitsmappe 1 ist als das Aktiv geöffnete mit dem aktiven Arbeitsblatt definiert in der das Makro ausgeführt werden soll, hier Suchquelle genannt. Arbeitsmappe 2 ist eine andere geöffnete Arbeitsmappe, das Arbeitsblatt der Arbeitsmappe 2 heißt "Prozessschritte", hier Suchmaske genannt.
In der Suchquelle stehen ab Spalte C8 Werte. Diese sollen in der Suchmaske mit Werten in Spalte C ab C8 abgeschlichen werden. Die Werte können mehrfach in Spalte C in der Suchmaske vorkommen, in den weiten Zeilen sind jedoch andere Werte enthalten sein die kopiert werden sollen (siehe später). Findet sich in der Suchmaske in Spalte C der Wert, soll aus der gleichen Zeile der Wert aus der Spalte J in die Zelle I der Suchquelle kopiert werden. Werden in der Suchmaske mehrere Ergebnisse des Wertes aus Spalte C in der Suchquelle gefunden, dann soll in der Suchquelle eine neue Zeile eingefügt werden. In dieser werden dann die Werte aus Zeile J in der Suchmaske eingefügt, sowie der dazugehörige Wert aus Spalte C. Es sollen alle Werte aus der Suchquelle in C einmal durchsucht werden, jedoch nicht die neueingefügten, da es sonst zu einem unendlich Loop kommt.
Leider verzweifle ich hier, da es bei mir immer zu einem Loop kommt. Auch die Werte vorher einzuschränken auf bspw. 300 Zeichen hilft nicht.

Über Hilfe wäre ich mehr als dankbar.
Das aktuelle Makro sieht wie folgt aus:
Sub SucheUndKopiereDaten()
Dim Suchquelle As Worksheet
Dim Suchmaske As Worksheet
Dim QuellBereich As Range
Dim SuchBereich As Range
Dim Zelle As Range
Dim Wert As Variant
Dim Treffer As Long
Dim ErsteZeile As Boolean
Dim ZelleInSuchmaske As Range

' Definieren Sie die Arbeitsblätter in der aktuellen Arbeitsmappe
Set Suchquelle = ThisWorkbook.ActiveSheet
' Geben Sie den Namen der anderen geöffneten Arbeitsmappe an
Set Suchmaske = Workbooks("Mappe2.xlsm").Worksheets("Prozessschritte") '

' Definieren Sie den Bereich in der Suchquelle (Spalte C) auf die ersten 300 Zeilen
Set QuellBereich = Suchquelle.Range("C8:C307") ' Hier werden die Zeilen 8 bis 307 durchsucht

' Definieren Sie den Bereich in der Suchmaske (Spalte C)
Set SuchBereich = Suchmaske.Range("C8:C" & Suchmaske.Cells(Suchmaske.Rows.Count, "C").End(xlUp).Row)

' Durchsuchen Sie die Werte in der Suchquelle
For Each Zelle In QuellBereich
Wert = Zelle.Value

' Überprüfen, ob der Wert in der Suchmaske gefunden wird
Treffer = WorksheetFunction.CountIf(SuchBereich, Wert)

If Treffer > 1 Then
' Mehr als einen Treffer gefunden
ErsteZeile = True

' Kopieren Sie die übereinstimmenden Werte aus Spalte J in der Suchmaske
For Each ZelleInSuchmaske In SuchBereich
If ZelleInSuchmaske.Value = Wert Then
If ErsteZeile Then
' Bei der ersten Übereinstimmung eine neue Zeile in der Suchquelle einfügen
Suchquelle.Rows(ZelleInSuchmaske.Row).Insert Shift:=xlDown
ErsteZeile = False
End If
' Kopieren Sie den Wert aus Spalte J in die Zelle I der Suchquelle
Suchquelle.Cells(ZelleInSuchmaske.Row, "I").Value = _
Suchmaske.Cells(ZelleInSuchmaske.Row, "J").Value
End If
Next ZelleInSuchmaske
End If
Next Zelle
End Sub

 

Hallo,

warum befinden sich Daten, die offenbar zusammen gehören, in zwei verschiedenen Arbeitsmappen? Ohne die zugehörige(n) Datei(en) kann man mit dem Makro nicht so sehr viel anfangen.

 

Hallo Klaus-Dieter,
das hat den Hintergrund, dass diese Dateien getrennt werden müssen und davon sehr viele gibt. Ich hatte mir auch schon üverlegt den Namen der Suchmaske in C6 festzuschreiben, das hat jedoch auch nicht geklappt. Ich habe in den Anhang einmal 2 Beispieldateien gehängt, da die richtigen Daten Kundendaten enthalten.

 

Hallo,

das erklärt das Problem nicht wirklich.

 

Die Dateien müssen in ein neues Arbeitsblatt mit anderer Formatierung eingefügt werden. Vorher waren die Zellen verbunden, das habe ich mit einem anderen Makro aufgelöst. Ich hoffe ich konnte das Problem besser beschreiben.