Clever-Excel-Forum

Hallo zusammen,

ich hatte im Vorfeld die Suche bemüht, jedoch leider nichts gefunden - was nichts bedeuten muss. Wenn also jemand einen Verweis hat: Weist mich gerne darauf hin.

Worum geht es?
Mit unseren Lieferanten soll ein Stammdatenabgleich gemacht werden. Das soll über eine Excel-Tabelle erfolgen, damit mögliche Änderungswünsche direkt eingetragen werden können.
Die Stammdaten liegen mir in einer vergleichbaren Form wie in beigefügter Liste vor.

Da die Liste im Original etwas umfangreicher ist, bin ich auf der Suche nach einer automatisierten Lösung. Die Idee ist nun, auf Grundlage der Spalte A (Lieferantennummer) die Artikel, die zu einem Lieferanten gehören, auf jeweils ein separates Tabellenblatt zu bringen, da ich eine VBA-Lösung gefunden habe, mit dem die Tabellenblätter als einzelne Dateien exportiert werden können.
Wie bekomme ich das hin?
Danke für Eure Unterstützung - gerne auch mit Gedankenanstößen für eine völlig andere Lösung,

Connor

P.S.: Ich habe dieses Thema auch noch in einem anderen Forum platziert.

Hallo Conner,

das Thema könnte man mit einer Makroaufzeichnung beginnen. Ich habe das hier mal getan - für die Lieferanten 111 ud 85.

Code:
Sub Makro1()

'

' Makro1 Makro

'

'

    Range("A1").Select

    Selection.AutoFilter

    ActiveSheet.Range("$A$1:$F$16").AutoFilter Field:=1, Criteria1:="111"

    Range("A1:F30").Select

    Selection.Copy

    Sheets("111").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Sheets("Gesamt").Select

    ActiveSheet.Range("$A$1:$F$16").AutoFilter Field:=1, Criteria1:="85"

    Application.CutCopyMode = False

    Selection.Copy

    Sheets("85").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

End Sub

Damit man jetzt nicht für jeden Lieferanten den code aufzeichnet, packen wir das Ganze in eine Schleife und optimieren den code etwas:

Code:
Sub Makro1()

'Variablendeklarationen

Dim arrLieferanten, iCnt%

'Array bilden

arrLieferanten = Array("111", "85")

'Blatt Gesamt auswaehlen

Sheets("Gesamt").Select

'Autofilter setzen

Range("A1").AutoFilter

'Schleife ueber alle Arrayelemente

For iCnt = 0 To UBound(arrLieferanten)

 'Kriterium fuer Autofilter setzen

 ActiveSheet.Range("$A$1:$F$16").AutoFilter Field:=1, Criteria1:=arrLieferanten(iCnt)

 'gefilterten Bereich + ein paar Zeilen mehr kopieren

 Range("A1:F30").Copy

 'Werte auf Zielblatt einfuegen

 Sheets(arrLieferanten(iCnt)).Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

     :=False, Transpose:=False

Next

'Kopiermarkierung ausschalten

Application.CutCopyMode = False

'Autofilter zuruecksetzen

Range("A1").AutoFilter

End Sub

Die nächsten Optimierungen könnten sein:
- Aufbau des Array alle Lieferanten per code
- Anlegen der Lieferantenblätter, sofern nciht vorhanden
- ggf. Löschen der Daten auf vorhandenen Lieferantenblättern
- zweiter Kopierstep zur Übertragung der Formate
Hinweis: Wenn alles kopiert werden kann (Daten, Foormate, Formeln usw), reicht einfaches kopieren und einfügen.

Hallo Schauan,

danke für Deinen Vorschlag. Ich hatte, wie beschrieben, noch in einem anderen Forum um Hilfe gebeten.
Dort hat man mir eine - wie ich finde - sehr schöne Lösung angeboten. Für diese habe ich mich entschieden, da hier "einfach" nur der VBA-Code eingefügt werden musste.
Ich hatte geplant, das Makro hier zu veröffentlichen, aber leider habe ich keine Rückmeldung vom Ersteller bekommen.
Deshalb hier einfach "nur" der Link.

Nochmals Danke für Deine Mühen,
Gruß,

Connor

Hallöchen,
Schön zu wissen... Ich versuche ganz gerne, die Lösung mit dem Fragesteller zusammen zu erarbeiten.

Connor0308

schauan

Connor0308

schauan