Spalten einer Tabelle als txt/csv exportieren

[mzansi]

Hallo zusammen

ich habe folgende Ausgangstabelle (s. Anhang):

Spalte A: Zeitangaben (in den Zeilen 1-1441) 
Spalten B-II: Temperaturdaten (in den Zeilen 1-1441) 

Folgender Endzustand ist erwünscht:

Die Spalten B-II sollen einzeln als eigene txt oder csv Dateien exportiert werden. Dabei soll jedoch immer Spalte A (Zeitangaben) angehängt werden, sodass alle eigenen txt/csv Dateien die Zeitangaben beinhalten. Die Zeitangabe soll dabei in Spalte A stehen und die jeweiligen Temperaturangaben in Spalte B.

Beispiel: textfile_1 = Spalte A (Zeitangaben) und Spalte B (Temperaturdaten der ursprünglichen Spalte B), texfile_2 = Spalte A (Zeitangaben) und Spalte B (Temperaturdaten der ursprünglichen Spalte C), textfile_3 = Spalte A (Zeitangaben) und Spalte B (Temperaturdaten der ursprünglichen Spalte D) usw...

Kann mir dabei jemand helfen (z.B. mit einem Macro)? Vielen Dank für eure Antworten!

[mmat]

Code:

Sub export()
Dim r As Long, c As Long, s As String
  r = 1: c = 2: s = CStr(Cells(r, 1))
  Do
    Open "Textfile " + s + ".txt" For Output As #1
    Print #1, s, Cells(r, c)
    Close #1
   
    r = r + 1: c = c + 1: s = CStr(Cells(r, 1))
  Loop Until r >= 1441
 
End Sub

[Kuwer]

Hallo,

z.B. so:

Sub aaa()

  Dim i As Long

  Dim oWbZ As Workbook

  Dim oWsQ As Worksheet

  Dim strZ As String

  

  strZ = "C:\Users\mzansi\Documents\ExcelTest\"  '<< anpassen

  Set oWsQ = ActiveSheet

  Set oWbZ = Workbooks.Add(xlWBATWorksheet)

  

  Application.ScreenUpdating = False

  Application.DisplayAlerts = False

  For i = 2 To 243

    Application.Union(oWsQ.Columns(1), oWsQ.Columns(i)).Copy oWbZ.Worksheets(1).Cells(1)

    oWbZ.SaveAs strZ & "textfile_" & i - 1 & ".txt", xlText

  Next i

  oWbZ.Close False

  Application.ScreenUpdating = True

  Application.DisplayAlerts = True

End Sub

Gruß Uwe

[snb]

Oder:

Code:

Sub M_snb()
  Set fs = CreateObject("scripting.filesystemobject")
  Set kb = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
  Sheet1.Cells(1).CurrentRegion.Columns(1).Copy Sheet1.Cells(1, 200)
   
  For Each it In Sheet1.Cells(1).CurrentRegion.Columns
    it.Copy Sheet1.Cells(1, 201)
    Sheet1.Cells(1, 200).CurrentRegion.Copy
    With kb
      .GetFromClipboard
      fs.createtextfile("G:\OF\Data_" & Format(it.Column, "0000") & ".txt").write .gettext
    End With
  Next
End Sub

[mzansi]

Allerbesten Dank! Das hat wunderbar geklappt!