Sub ueberleitung()
Dim pfad As String
Dim auswahl As Range
Set auswahl = Selection
pfad = Application.ActiveWorkbook.Path & "\"
If auswahl.Columns.Count = 1 Then
Do
sDat = InputBox("Bitte Dateinamen (ohne Pfad + .txt) eingeben", "Dateneingabe")
lp = dOpen(pfad & sDat & ".txt")
Loop While lp <> 1
sDat = sDat & ".txt"
fnr = FreeFile
Open sDat For Output As #fnr
For Each n In auswahl
Print #fnr, n.Value
Next
Close #fnr
MsgBox "Aktion durchgeführt in " & pfad, vbOKOnly + vbInformation, "abgeschlossen"
Else
MsgBox "Bitte nur eine Spalte auswählen", vbOKOnly + vbCritical, "Anwendungsfehler"
End If
End Sub
Function dOpen(name)
On Error Resume Next
ausw = 0
fnr = FreeFile
Open name For Input As #fnr
If Err.Number = 53 Then
ausw = 1
GoSub ok
End If
alt = MsgBox("Dieser Name existiert bereits" & Chr(13) & "Soll die Datei überschrieben werden (j/n)", vbYesNo + vbQuestion, "Dateneingabe")
If alt = 6 Then ausw = 1
ok:
Close #fnr
dOpen = ausw
End Function