![]() |
Betrifft: bestimmt Blätter der Arbeitsmappe nach csv
von: Rene
Geschrieben am: 07.09.2014 12:32:41
Hallo zusammen
Ich versuche bestimmte Tabellenblätter einer Arbeitsmappe via VBA als csv Datei in einem Ordner zu speichern .Habe hier in Forum schon einen Code gefunden mit dem ich das für ein Tabellenblatt auch zufriedenstellend umgesetzt habe .Leider komme ich nicht weiter um weitere Tabellenblätter in der Mappe azusprechen und ebenso als csv Datei zu speichern.
Wäre über eure Hilfe dankbar.
Die Beispieldatei soll die Frage verdeutlichen
https://www.herber.de/bbs/user/92506.xlsm
Vielen Dank
![]() ![]() |
Betrifft: AW: bestimmt Blätter der Arbeitsmappe nach csv
von: fcs
Geschrieben am: 08.09.2014 10:09:53
Hallo Rene,
ein entsprechendes Makro, das die Blätter 3 bis 7 in einer Schleife abarbeitet sieht dann wie folgt aus.
Gruß
franz
Sub SaveCSV_3_7() Dim A As Variant Dim B() As String Dim D() As String Dim Z As Long Dim s As Byte Dim r As Long Dim C As Byte Dim Filename As String Dim wks As Worksheet Dim iWks As Integer Dim Path As String '= "C:\Users\derbbrsa\ED\Exel\CSV\" Const Extension As String = ".CSV" Const Separator As String = "," Const Wrapper As String = """" 'Verzeichnisname einlesen und ggf. Verzeichnis anlegen Path = ActiveWorkbook.Path & "\" & ActiveWorkbook.Worksheets("Masterdata").Range("B2") If Dir(Path, vbDirectory) = "" Then VBA.MkDir Path End If Path = Path & "\" For iWks = 3 To 7 Set wks = ActiveWorkbook.Sheets(iWks) With wks 'Const Filename As String = Range("I3").Value & Format(Now, "_yyyy_mm_dd_hhmm") Filename = .Range("c1").Value & "_" & .Range("B1").Value & "_" & .Range("I3").Value _ & Format(Now, "_dd_mm_yyyy_hhmm") 'Here you can define your own Range, too A = .UsedRange If Not IsEmpty(A) Then Z = UBound(A, 1) s = UBound(A, 2) ReDim D(Z - 1) For r = 2 To Z ReDim B(s - 1) For C = 1 To s If InStr(1, A(r, C), Separator) > 0 Then 'Rows whith cells including the Separator 'put in Wrapper B(C - 1) = Wrapper & A(r, C) & Wrapper Else B(C - 1) = A(r, C) End If Next C D(r - 1) = Join(B(), Separator) Next r Open Path & Filename & Extension For Output As #1 'Print #1, "sep=" & Separator & vbCrLf & Join(D(), vbCrLf) Print #1, "UTF-8" & Join(D(), vbCrLf) Close #1 End If End With Next iWks End Sub
![]() ![]() |
Betrifft: AW: bestimmt Blätter der Arbeitsmappe nach csv
von: Rene
Geschrieben am: 09.09.2014 18:11:21
Hallo Franz
Vielen Dank ,funktioniert wie gewünscht ,super !
Rene
![]() |