|
Hi,
versuch mal folgenden Code. Den Bereich musst du natürlich anpassen. Bereich sind die 6 Spalten von RO bis RW.
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"
'Bereich setzen inkl. Überschriften
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
'oder alternativ im Tabellenformat
'Print #1, Vorname, Name, rorw, Verzeichnis
End If
Next c
Close #1
End Sub
Gruß Mr. K.
|