Sub createCsgFiles()
Dim fso As New Scripting.FileSystemObject
Dim ts As Scripting.TextStream
Dim myArr() As String
Dim r As Integer
Dim i As Integer
Dim s As String
Dim intLastRow As Integer
Dim strFilename As String
With Sheets("Tabelle2")
intLastRow = .Cells(Rows.Count, 1).End(xlUp).row
End With
For r = 1 To intLastRow
For i = 0 To 6
ReDim Preserve myArr(i)
myArr(i) = subString(Sheets("Tabelle2").Cells(r, i + 1).Value)
Next i
s = Join(myArr, vbTab)
strFilename = Sheets("Tabelle2").Cells(r, 8).Value
Set ts = fso.OpenTextFile(Environ("UserProfile") & "\desktop\" & strFilename & ".csg", ForAppending, True)
ts.WriteLine s
ts.Close
Next r
End Sub
Function subString(ByVal strText As String) As String
subString = Mid(strText, InStr(1, strText, Chr(34)) + 1, Len(strText) - InStr(1, strText, Chr(34)) - 1)
End Function