Sub Mokus()
Const defPath = "d:\1"
Dim fileSaveName, rr As Range, n As Integer, i As Integer
If Dir(defPath, vbDirectory) = "" Then MkDir defPath
ChDir defPath
fileSaveName = Application.GetSaveAsFilename(Replace(ActiveWorkbook.Name, ".xls", ""), _
"Text Files (*.txt), *.txt", , "?????????? ??? ?????? ??????? :)")
If fileSaveName <> False Then
Open fileSaveName For Output As #1
For Each rr In ActiveSheet.UsedRange.Rows
        n = rr.Cells.Count
        For i = 1 To n - 1
            Print #1, rr.Cells(i).Text; vbTab;
        Next
        Print #1, rr.Cells(n)
    Next
Close #1
End If
End Sub