Private Sub CommandButton1_Click()
NamFile = InputBox(prompt:="Введите имя сохраняемого файла", Title:="Сохранение файла")
thisfile = ThisWorkbook.Path & Application.PathSeparator & NamFile & ".txt"
On Error Resume Next
Kill (thisfile)
On Error GoTo 0
Open thisfile For Output As #1
    Worksheets("lisp").Activate
    ActiveSheet.Range("a1").Select
        For i = 1 To 500
        Pus = ActiveCell.Value
            If Pus = "" Then
            AdresRow = i
        Exit For
            Else
            ActiveCell.Offset(1, 0).Range("A1").Activate
            End If
        Next i
        
    For j = 1 To AdresRow
        Print #1, ActiveSheet.Cells(j, 1).Value
    Next j
Close #1
MsgBox "Файл " & thisfile & " успешно сохранен."
End Sub

[/CODE][CODE]Sub example_01()ActiveWorkbook.SaveAs "sheet4.txt", FileFormat:=xlText, CreateBackup:=False
ActiveWorkbook.Close 0
End Sub

[/CODE]

[CODE]Sub example_02()
Dim x, y(), i&, j&, s$
x = ActiveSheet.UsedRange.Value
If IsArray(x) Then
 ReDim y(1 To UBound(x))
 For i = 1 To UBound(x)
 For j = 1 To UBound(x, 2)
 y(i) = y(i) & vbTab & x(i, j)
 Next j
 Next i: s = Join(y, vbCrLf)
Else
 s = x
End If
With CreateObject("scripting.filesystemobject")
 With .CreateTextFile(ThisWorkbook.Path & "\sheet44.txt", True)
 .Write s: .Close
 End With
End With
MsgBox "Ok", 64
End Sub