Bitte um Hilfe bei csv-Export

Hallo liebe Forumsmitglieder,
bitte um Hilfe bei folgendem Problem: Ich habe eine Excel-Datei mit ca. 600 Datensätzen/Zeilen, diese muß ich nach verschiedenen Kriterien zu Gruppen zusammenfassen (in der Beispieldatei durch die ID angedeutet), anschließend pro Gruppe einige Felder manuell in ein neues Blatt kopieren und als csv-Datei abspeichern-und das so ca. 70 mal:-(( würde das jetzt gern wie folgt per vba automatisieren: ich markiere die Zeilen die einer Gruppe entsprechen (in der Beispieldatei farbig hinterlegt) - filtere irgendwie die Felder die ich brauche heraus und speichere das ganze als csv-Datei in einem Ordner dessen Pfad immer gleich bleibt, und der Speichername sollte sich aus SuffixKW_ID ergeben-also im Beispiel "Benord30_4". Ich hab leider nur ganz spärliche VBA-Kentnisse und würde mich über jede Hilfestellung/Tip sehr freuen!!
Hier noch der Link zur Beispieldatei
https://www.herber.de/bbs/user/81181.xls
LG und vielen Dank schon mal im voraus
Thomas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Option Explicit Sub Filtern() Dim Zei As Long, colC As New Collection, C As Long On Error Resume Next Call Loesch With Worksheets("KW30") .Range("A4:K4").Copy .Range("M1") Zei = .Range("A4").End(xlDown).Row For C = 5 To Zei colC.Add Item:=CStr(.Cells(C, 7).Value), key:=CStr(.Cells(C, 7).Value) Next C On Error GoTo 0 For C = 1 To colC.Count .Range("S2") = colC(C) Call csvTab(.Range("A4:K" & Zei), .Range("M1:S2")) Next C .Range("M1:S2").ClearContents End With End Sub Sub csvTab(ByRef Liste As Range, ByRef Krit As Range) Worksheets.Add after:=Worksheets(Worksheets.Count) Liste.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Krit _ , CopyToRange:=Range("A1"), Unique:=False Rows(1).Delete Columns("D:I").Delete Columns("E").Delete ActiveSheet.Name = "csvTab" & Krit.Cells(2, 7).Value End Sub Sub Loesch() Dim wks As Worksheet Application.DisplayAlerts = False For Each wks In Worksheets If wks.Name Like "csvTab*" Then wks.Delete Next wks Application.DisplayAlerts = True End Sub

Hallo Reinhard.
ja ich weiß die Tabelle ist sehr ungeschickt-kann das aber nicht ändern da die so vom Kunden kommt.
Manuell kopieren geht leider aus div. Gründen nicht-hab aber eine andere Möglichkeit gefunden-zur Erinnerung: Ich markiere im "Hauptblatt" einige Zeilen (genau die die ich halt jetzt grad brauche) - mit
Intersect(Selection, Union(Columns(1), Columns(2), Columns(3), Range("Suffix"), Range("Größe"))).Copy
Worksheets.Add after:=Worksheets(Worksheets.Count)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Name = "csvTab"
bekomme ich jetzt auch ein neues Blatt mit dem man vielleicht was anfangen kann.
Sieht so aus:
5411 Oberalm 1555 100 BETENN
5412 Puch bei Hallein 1665 100 BETENN
5424 Vigaun 731 100 BETENN
Folgende Probleme schaff ich aber wieder nicht:
Export geschieht mit falschem Trennzeichen - brauch unbedingt ";" -habs mit Local=True probiert aber trotzdem war das Trennzeichen ","
Pfad wo gespeichert werden soll ist ja fix-der Speicherame soll sich aber aus Spalte E + aktueller KW + "_"+Spalte D+.csv ergeben
Die Spalte D darf auch nicht mitexportiert werden-die hab ich nur mitkopiert weil ich nicht gewusst hab wie ich sonst an diesen Wert kommen könnte (schäm)....
also zusammenfassend-wenn ich aus obigen Tabellenblattinhalt eine CSV-Datei bekomme die so ausschaut:
5411;Oberalm;1555;BETENN
5412;Puch bei Hallein;1665;BETENN
5424;Vigaun;731;BETENN
und so heisst: BETENN32_100.csv
dann sind vorerst einmal meine Probleme gelöst:-))
Danke Dir nocchmal für deine Unterstützung und wünsche einen schönen Sonntag!!
lg Thomas

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread