Microsoft Excel

Herbers Excel/VBA-Archiv

bestimmt Blätter der Arbeitsmappe nach csv

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


 

Beiträge aus den Excel-Beispielen zum Thema "bestimmt Blätter der Arbeitsmappe nach csv"