Verschieben auf weitere Tabellenblätter auf Spaltenbasis

[Connor0308]

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.

[schauan]

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.

[Connor0308]

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

[schauan]

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