Makro-Frage an die Profis

Hallo,
ich habe wiedermal ein Problem, welches mein Können im VBA-Modus "etwas" übersteigt. Und zwar:
Ausgangstabelle:
A........................B.........................C.......................D..................E
Info1.................Info2..................Info3...............Info4...............Kunde
Kohl..................rund...................grün.................lecker.........Herr Großkauf
Erbsen..............rund...................grün.................bitter.........Herr Suppengrün
Äpfel..................rund..................rot.....................süß............Herr Großkauf
Wunschergebnis:
Exceldatei:
Herr Großkauf.xls
A........................B.........................C.......................D..................E
Info1.................Info2..................Info3...............Info4...............Kunde
Kohl..................rund...................grün.................lecker.........Herr Großkauf
Äpfel..................rund..................rot.....................süß............Herr Großkauf
Herr Suppengrün.xls:
A........................B.........................C.......................D..................E
Erbsen..............rund...................grün.................bitter.........Herr Suppengrün
Dadurch, dass meine Ausgangstabelle wesentlich länger, als das Beispiel ist und viele Kunden enthält, wäre es genial, wenn ich für jeden Kunden automatisch eine eigene Exceldatei erhalten könnte. So könnte ich bei meiner Kundenanfrage jedem Kunden nur seine Daten zukommen lassen.
Ist soetwas technisch überhaupt machbar? Jeder Kunde nicht in einer eigenen Datei, sondern schon in einem eigenen Tabellenblatt wäre auch schon super.
Viele Grüße und danke im Voraus für Eure Hilfe,
Gruß Fabian

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Sub tt() Dim wkb As Workbook, oKunden As Object, i As Long, _ arrDaten(), arrCount, arrKunde, rngC As Range, n As Long Set oKunden = CreateObject("Scripting.dictionary") For Each rngC In Range(Cells(2, 5), Cells(Rows.Count, 5).End(xlUp)) If Not oKunden.exists(rngC.Value) Then oKunden.Add rngC.Value, Application.CountIf(Columns(5), rngC.Value) End If Next arrKunde = oKunden.keys arrCount = oKunden.items For i = 1 To oKunden.Count n = 1 ReDim arrDaten(1 To arrCount(i - 1) + 1, 1 To 5) arrDaten(n, 1) = Cells(1, 1) arrDaten(n, 2) = Cells(1, 2) arrDaten(n, 3) = Cells(1, 3) arrDaten(n, 4) = Cells(1, 4) arrDaten(n, 5) = Cells(1, 5) For Each rngC In Range(Cells(2, 5), Cells(Rows.Count, 5).End(xlUp)) If rngC = arrKunde(i - 1) Then n = n + 1 arrDaten(n, 1) = rngC.Offset(, -4) arrDaten(n, 2) = rngC.Offset(, -3) arrDaten(n, 3) = rngC.Offset(, -2) arrDaten(n, 4) = rngC.Offset(, -1) arrDaten(n, 5) = rngC End If Next Set wkb = Workbooks.Add(1) With wkb .Sheets(1).Range(Cells(1, 1), Cells(arrCount(i - 1) + 1, 5)) = arrDaten .SaveAs arrKunde(i - 1) & ".xls" .Close End With Next End Sub

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread