Zelleninhalte in mehrere Text Dateien schreiben und Dateiname aus Zelle nutzen

[Paul Panzer]

Hi zusammen,

ich habe diverse Foren durchsucht und leider keine zufriedenstellende Lösung finden können. Info dazu vorab: VBA bin ich kein Experte.

Problemstellung:
Ich habe eine Excel mit einem Arbeitsblatt und fixe Anzahl an Spalten und eine unbekannte Anzahl an Zeilen (mehr als 500 werden es aber nicht sein).

In Spalte F steht in F1 die Überschrift und ab F2 folgen dann die jeweiligen Inhalte pro Zeile bis Zeile Fxxx.
In Spalte BE steht in BE1 die Überschrift und ab BE2 eine eindeutige ID für jede Zeile bis Zeile BExxx.

Ich möchte nun, dass der Inhalt aus F2 bis Fxxx in jeweils eine eigene txt Datei geschrieben wird und der Dateiname der jeweiligen txt Datei dann die ID aus Spalte BE ist.

Beispiel 
  Excel_Beispiel.xlsm (Größe: 17,07 KB / Downloads: 2) :

    A       ...    F                                                          ...         BE
1  Bli      ...    Das ist ein Kommentar für Zeile 1            ...         1234
2  Bla     ...    Das ist ein noch besseres Kommentar      ...         7890
3  Blubb ...    Hier stehen auch wichtige Sachen            ...         1337


Erwartetes Ergebnis ist also:
1234.txt --> Inhalt: Das ist ein Kommentar für Zeile 1
7890.txt --> Inhalt: Das ist ein noch besseres Kommentar
1337.txt --> Inhalt: Hier stehen auch wichtige Sachen


Ich habe auch einen Code gefunden der im Ansatz schon hilft, aber hier muss jede Zeile definiert werden und bei 500 Zeilen händisch immer einzugreifen ist nicht spaßig.
Aber vielleicht habt ihr noch andere Ideen?


Danke & Gruß
Paul 

Code:

Sub WriteFreefile()
Dim lngFreeFile    As Long
Dim lngRowsCount   As Long
Dim lngLastRow     As Long

Dim strInhalt      As String

' Dateizähler festlegen
lngFreeFile = FreeFile

' Letzte beschriebene Zeile ermitteln
lngLastRow = Range("A" & Rows.Count).End(xlUp).Row

' Freefile öffnen
Open Range("BE2").Value & "_comments.txt" For Output As #lngFreeFile

'Zeilen schreiben
For lngRowsCount = 2 To lngLastRow
    strInhalt = Cells(lngRowsCount, 6).Value & " "

    Print #lngFreeFile, strInhalt
Next lngRowsCount

' Freefile schließen
Close #lngFreeFile
'
End Sub

[Oberon]

Hi,

Du musst noch etwas mehr in die Schleife packen:

PHP-Code:

Sub WriteFreefile()
Dim lngFreeFile    As Long
Dim lngRowsCount   As Long
Dim lngLastRow     As Long
Dim strInhalt      As String

' Dateizähler festlegen
lngFreeFile = FreeFile

' Letzte beschriebene Zeile ermitteln
lngLastRow = Range("A" & Rows.Count).End(xlUp).Row

'Zeilen schreiben
For lngRowsCount = 2 To lngLastRow
    ' Freefile öffnen
    Open Range("BE" & lngRowsCount).Value & "_comments.txt" For Output As #lngFreeFile
    strInhalt = Cells(lngRowsCount, 6).Value & " "

    Print #lngFreeFile, strInhalt
    ' Freefile schließen
    Close #lngFreeFile
Next lngRowsCount

End Sub 


Versuch es mal so.

CU
Oberon

[HKindler]

Hi,

du musst doch nur deinen Schleifenstart weiter nach vorne schieben...

Code:

Sub WriteFreefile()
Dim lngFreeFile    As Long
Dim lngRowsCount   As Long
Dim lngLastRow     As Long
Dim strInhalt      As String

' Letzte beschriebene Zeile ermitteln
lngLastRow = Range("A" & Rows.Count).End(xlUp).Row
'Zeilen schreiben
For lngRowsCount = 2 To lngLastRow
    'Dateizähler festlegen
    lngFreeFile = FreeFile
    'Freefile öffnen
    Open Range("BE" & lngRowsCount).Value & "_comments.txt" For Output As #lngFreeFile
    strInhalt = Cells(lngRowsCount, 6).Value & " "
    Print #lngFreeFile, strInhalt
    'Freefile schließen
    Close #lngFreeFile
Next lngRowsCount
End Sub

UNGETESTET

[Paul Panzer]

Ach ein Traum, danke vielmals. 
Es hat funktioniert (Code von Oberon habe ich nur ausprobiert, dass passte schon)
Merci