Erstellen neuer Dateien mit Autofilter

Hallo zusammen,
erst einmal möchte ich erwähnen, dass ich neu bin und daher noch nicht so vertraut bin mit der Art und Weise, wie ich am besten eine Frage im Forum korrekt platziere. Bitte daher um Verständnis :)
Ich habe folgendes Anliegen:
Ich habe personenbezogene Daten in eine Excel-Tabelle ausgelagert und möchte nun mit Hilfe von VBA und Autofilter eigene Dateien pro Sachbearbeiter erzeugen und diese auch so benennen. Zum Beispiel habe ich nach dem Sachbearbeiter 207 gefiltert und ausgelagert, dann soll die Datei unter einem bestimmten Pfad (am besten wird der Nutzer durch ein Pop up gefragt, wo die Datei abgespeichert werden soll) und mit dem Dateinamen 207.xlsx als Einzeldatei abgespeichert werden.
Ich habe es bereits hinbekommen, wie ich einen AutoFilter setze und nach einem bestimmten Wert filtere und diese Daten in ein eigenes Tabellenblatt auslagern kann. Mein Problem besteht darin, dass je nach Tabelle die Einträge in der Spalte Sachbearbeiter variieren können. Es kann also vorkommen, dass es 4 verschiedene Sachbearbeiter gibt und ich nach Ausführung des Makros 4 Dateien erwarte oder aber es sind 100 verschiedene Sachbearbeiter und somit 100 verschiedene Einzeldateien erzeugt werden sollen.
Wie kann ich also das Setzen des Filters automatisieren, sprich nimm alle Werte aus Spalte D entferne die Duplikate und beginne nun zu Filtern. Erstelle die Einzeldatei mit dem Dateinamen des Zellenwerts.
Geht das über ein Array? Oder muss ich die Spalte vorher manuell auslagern die Duplikate mitgeben und dann das Array befüllen?
Ich habe meine Beispieldatei hochgeladen: https://www.herber.de/bbs/user/149243.xlsm
Das Idealbild wäre:
Makro wird ausgeführt, der Anwender wird nach dem Pfad gefragt und kann zum Ablageort navigieren, bestätigt diesen durch einen Klick auf Speichern und die Einzeldateien werden erzeugt samt Inhalt und Dateiname.
Ich hoffe es ist verständlich ausgedrückt. :) Ich erwarte natürlich nicht, dass mir einer den fertigen Code schickt, sondern möchte wissen, ob das umsetzbar ist und ich nicht auf dem Holzweg bin :)
Vielen Dank!
VG Damir

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub eineDateiJeLandkreis() Dim i As Integer Dim countData As Integer Dim countLK As Integer Dim startPos As Integer Dim endPos As Integer Dim Landkreis As String Dim sFolder As String i = 2 countData = Sheets(1).UsedRange.Rows.Count countLK = 1 With Application.FileDialog(msoFileDialogFolderPicker) If .Show = -1 Then ' if OK is pressed sFolder = .SelectedItems(1) End If End With 'MsgBox countData Do startPos = i Landkreis = Range("B" & i).Value While Range("A" & i) = countLK i = i + 1 Wend endPos = i - 1 Rows(startPos & ":" & endPos).Copy 'Destination:=Workbooks.Add ...? Workbooks.Add With ActiveWorkbook ' die eben neu erzeugte Datei, nicht dieser hier, in der das Makro läuft .Sheets(1).Rows(1).Value = ThisWorkbook.Sheets(1).Rows(1).Value ' die Überschrift Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False ' die Daten Application.CutCopyMode = False If sFolder "" Then .SaveAs Filename:=sFolder & "\" & Landkreis & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False Else .SaveAs Filename:="C:\temp\" & Landkreis & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False End If .Close End With countLK = countLK + 1 Loop Until i > countData End Sub

Beliebteste Forumthreads (12 Monate)

Erstellen neuer Dateien mit Autofilter

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread