Sub Delim()

Dim i As Long, j As Long
Dim PathForFile As String
Dim NameForSave As String
Dim FileFormat As String
Dim tempstr As String
Dim Rn As Range
Dim Delim1 As String
Dim Delim2 As String
Dim Val
On Error Resume Next
PathForFile$ = ThisWorkbook.Path & "\Реестры\": MkDir PathForFile$

If Err.Number <> 75 And Err.Number <> 0 Then GoTo Ext
Err.Clear
On Error GoTo Ext
NameForSave = InputBox("Укажите маску файла", "Ввод", ActiveWorkbook.Name)
Delim1 = CStr(";")
Delim2 = CStr("")
Randomize
NameForSave = NameForSave & "_" & CStr(Date)
Set Rn = Range("A1:U1")
i = 1
While Len(Rn.Cells(1).Offset(i).Value) > 0
i = i + 1
Wend
If i = 1 Then Exit Sub
Val = Rn.Offset(1).Resize(i).Value
On Error Resume Next
Kill PathForFile$ & "\" & NameForSave & ".txt"
Err.Clear
On Error GoTo Ext
Open PathForFile$ & "\" & NameForSave & ".txt" For Output As #1

For i = 1 To UBound(Val, 1) - 1
tempstr = Delim2 & CStr(Val(i, 1)) & Delim2
For j = 2 To UBound(Val, 2)
tempstr = tempstr & Delim1 & Delim2 & CStr(Val(i, j)) & Delim2
Next j
Print #1, tempstr
Next i

Close #1

Exit Sub
Ext:
MsgBox "Ошибка" & Err.Number & " " & Err.Description, vbOKOnly, "Упс!"
End Sub