Zellen mit bestimmten Inhalt ausschneiden und verschieben

[REK]

Hallo zusammen,
ich stehe vor einer Herausforderung.
Für eine Inventur (Zähllisten werden in Excel von einem Scanner importiert) muss ich bestimmte Artikel aus den generierten Listen suchen, ausschneiden und in einer dritten Daten verschieben.
Hierzu gibt es drei Typen von Dateien, welche sich in der Funktion unterscheiden:
1. Datei: Referenzdatei. Hier stehen in Spalte "A" nur Artikelnummern (ca. 2000). Dies sind die Artikel, welche später aus den Zähllisten ausgeschnitten werden sollen
2. Datei: Ergebnisliste: hier sollen die gefundenen Zellen der Zähllisten eingefügt werden
3. Datei(en): Zähllisten. Davon gibt es ca. 100. Diese Inhalte werden von einem Scanner importiert und haben mehrere Informationen (Artikelnummer, Lagercode, ...)
Der Ablauf einer VBA-Lösung soll wie folgt aussehen:
- nach Import der Daten aus dem Scanner soll ein Makro (manuell) gestartet werden, welches die Zählliste nach den Artikelnummern aus Spalte "A" der Referenzdatei durchsucht. Die Spalte in den Zähllisten mit den Artikelnummern ist ebenfals die Spalte"A". Jedoch kann es vorkommen, dass mehrere Ergebnisse unterschiedlicher Artikelnummern in den Zähllisten zu finden sind.
- wird eine Artikelnummer in den Zähllisten gefunden, soll die ganze Zelle ausgeschnitten werden und in die Ergebnisliste untereinander kopiert werden, bis der letzte Eintrag in den Zähllisten erreicht wurde.
...im schlimmsten Falle (nehmen wir an, in den Zähllisten sind nur Artikel, welche in der Referenzliste aufgelistet sind) würde in diesem Beispiel nach Beendigung des Makros die Zählliste leer sein und die Ergebnisliste voll.
Zu vermerken ist auch, dass die gefundenen Inhalte aller Zähllisten nur in einer Ergebnisliste abgespeichert (verschoben) werden sollen.

Puhh, ich hoffe, ich habe meine Anforderung so niedergeschrieben, dass es verständlich wirkt und freue mich auf positive Rückmeldungen

Gruß

[1Matthias]

Moin!
Willst du dazu Tipps haben oder Codefragmente?
Für letzteres müsstest du noch erklären, wo die Dateien genau liegen. (selber Ordner oder anderer Pfad) Zudem bräuchte man noch den genauen Namen der Dateien, Oder liegen die Zähllisten alle in einem Ordner und haben immer variable Namen? Dann halt den Ordnernamen.
VG

[REK]

Hallo,

am besten den Code!
Die Dateien (Zähllisten) liegen unter g:\Inventur\ und haben unterschiedliche Benennungen.
Die Referenzdatei liegt unter g:\inventur\referenz\ und hat eine feste Benennung Referenz.xlsm.
Die Ergebnisliste liegt unter g:\invenutr\ergebnis\ und hat die Benennung Ergebnis.xlsm.

Zu beachten ist, dass die Zähllisten den Code bereits haben, bevor die Daten aus dem Scanner importiert werden.

Gruß

[1Matthias]

Moin!
NOchmal zum Verständnis. Der Code soll in die Dateien Zähliste!?
Wenn ja, wäre es nicht besser, der Code ist in der Ergebnisliste. Vorteil wäre, du machst dort nur ein Click und alle Dateien werden ausgelesen. Zudem brauchst du bei Codeänderungen (bspw. der PFad zur Referenzdatei) nicht in mehreren Datei was ändern.
Ist nur ein Vorschlag. Wenn sie aber in die Zählistendateien sollen, ist das auch kein Problem.
VG

[REK]

Hallo,
danke der Nachfrage.
Der COde soll in die Zähllisten!

Gruß

[1Matthias]

Moin!
Hier mal der Code für dein Projekt. Der ist jetzt so erstellt, dass er in die Datei Zählliste kommt. Es wird nicht geprüft, ob die Daten existieren. Du müsstest im Code noch was anpassen. Immer da wo Kommentare sind, mal drüberschauen. Am Anfang ist es der Pfad und die Namen der Dateien für das ergebnis und die Referenz. Später dann ggf. die Tabellennamen in den Dateien und du kannst noch entscheiden, ob Überschriften da sind oder nicht.
Den Code bitte mal an Testdateien und nicht den Originalen testen (sonst könnten Daten weg sein).

Code: Alles auswählen

Sub übetragen()

Dim ergebnis, referenz, ergblatt, quelle
Dim pfadErg As String, pfadRef As String
Dim datenRef
Dim tempende As Long, zeilen As Long, zeile As Long, zeileErg As Long, zeileR As Long

'das ist die Datei Zählliste, dort ggf. den Blattnamen ändern
Set quelle = ActiveSheet

'Pfad und gleich den Dateinamen - anpassen
pfadErg = "C:\Users\Ergebnis.xls"
pfadRef = "C:\Referenz.xls"

'Referenzdaten holen
Set referenz = Workbooks.Open(pfadRef)
'hier ggf,. den Blattnamen in der Datei Referenz ändern
With referenz.Worksheets("Tabelle1")
tempende = .Cells(.Rows.Count, 1).End(xlUp).Row
datenRef = .Cells(1, 1).Resize(tempende, 1).Value
End With
referenz.Close

'ergebnis öffnen
Set ergebnis = Workbooks.Open(pfadErg)
'hier ggf,. den Blattnamen in der Datei Ergebnis ändern
Set ergblatt = ergebnis.Worksheets("Tabelle1")

zeileErg = ergblatt.Cells(ergblatt.Rows.Count, 1).End(xlUp).Row + 1

zeilen = quelle.Cells(quelle.Rows.Count, 1).End(xlUp).Row

'falls in Zeile 1 schon Daten und keine Überschrift stehen, dann die 2 zu einer 1 machen
'starten die Daten in einer anderen Zeilen und davor ist leer dann lassen ansonsten ggf. anpassen
For zeile = 2 To zeilen
    If quelle.Cells(zeile, 1) <> "" Then
        'falls im Referenzblatt in Zeile 1 eine Überschrift steht, dann in der nächsten Zeile die 1 in eine 2 wandeln
        For zeileR = 1 To tempende
            If quelle.Cells(zeile, 1) = datenRef(zeileR, 1) Then
                quelle.Rows(zeile).Copy ergblatt.Rows(zeileErg)
                quelle.Rows(zeile).Delete
                zeileErg = zeileErg + 1
                zeile = zeile - 1
                Exit For
            End If
        Next
    End If
Next

ergebnis.Close savechanges:=True

End Sub


VG

[REK]

Guten Morgen,

der Code ist Klasse.
Vielen herzlichen Dank

REK