Clever-Excel-Forum

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!

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

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

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

Allerbesten Dank! Das hat wunderbar geklappt!

mzansi

mmat

Kuwer

snb

mzansi