Sub
InTxtSchreiben()
Dim
Vorname
As
String
, Name
As
String
, Email
As
String
, Abteilung
As
String
, Verzeichnis
As
String
, rorw
As
String
Pfad =
"E:\Pfad\Datei.txt"
Set
Bereich = Range(
"G11:L"
& Range(
"B"
& Rows.Count).
End
(xlUp).Row)
Open Pfad
For
Output
As
#1
For
Each
c
In
Bereich.Cells
If
c =
"x"
Then
Vorname = Range(
"B"
& c.Row)
Name = Range(
"C"
& c.Row)
Email = Range(
"D"
& c.Row)
Abteilung = Range(
"E"
& c.Row)
rorw = Cells(Bereich.Row, c.Column)
Select
Case
c.Column - Bereich.Column + 1
Case
1, 2
Verzeichnis =
"Geschäftsführung"
Case
3, 4
Verzeichnis =
"Produktion"
Case
5, 6
Verzeichnis =
"Verwaltung/Versand"
End
Select
Print #1, Vorname &
";"
& Name &
";"
& rorw &
";"
& Verzeichnis
End
If
Next
c
Close #1
End
Sub