Sub SaveClipboardTextToCopySheet()
    Dim clipboardData As DataObject
    Dim copiedText As String
    Dim copySheet As Worksheet
    Dim textLines() As String
    Dim i As Long
    
    ' Create a new instance of the DataObject to access the clipboard
    Set clipboardData = New DataObject
    
    ' Get the text from the clipboard
    clipboardData.GetFromClipboard
    copiedText = clipboardData.GetText
    
    ' Split the copied text into separate lines
    textLines = Split(copiedText, vbCrLf)
    
    ' Check if the "Copy" sheet exists, create it if it doesn't
    On Error Resume Next
    Set copySheet = ThisWorkbook.Sheets("Copy")
    On Error GoTo 0
    
    If copySheet Is Nothing Then
        ' Create the "Copy" sheet if it doesn't exist
        Set copySheet = ThisWorkbook.Sheets.Add
        copySheet.Name = "Copy"
    Else
        ' Clear existing content in the "Copy" sheet
        copySheet.Cells.Clear
    End If
    
    ' Paste the text into the "Copy" sheet with final formatting
    copySheet.Range("A1").Resize(UBound(textLines) + 1, 1).Value = WorksheetFunction.Transpose(textLines)
    copySheet.Range("A1").Resize(UBound(textLines) + 1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    
    ' Optional: Clear the clipboard after saving the text
    clipboardData.Clear
End Sub

Option Explicit
Const iFileName As String = "D:\TS"
Const rRng As String = "A1:BU100"

Sub abc_xyz()
Range("C1") = 100
Range("C1:C100").DataSeries Step:=1
Application.Wait (Now + TimeValue("00:00:03"))

    With Application
        .ScreenUpdating = False: .DisplayAlerts = False
        Dim iSource As Range
        Set iSource = .ThisWorkbook.ActiveSheet.Range(rRng)
        .Workbooks.Add (xlWBATWorksheet)
        iSource.Copy .ActiveWorkbook.Worksheets(1).Range("A1")
        Set iSource = Nothing
        .ActiveWorkbook.SaveAs iFileName & Range("A1"), xlText ', Local:=True
        .ActiveWorkbook.Close False
        .DisplayAlerts = True: .ScreenUpdating = True
    End With
End Sub

Const iFileName As String = "D:\1.txt"
Const rRng As String = "A1:B99"
Range("C1") = 1
Range("C1:C99").DataSeries Step:=1
Application.Wait (Now + TimeValue("00:00:03"))

    With Application
        .ScreenUpdating = False: .DisplayAlerts = False
        Dim iSource As Range
        Set iSource = .ThisWorkbook.ActiveSheet.Range(rRng)
        .Workbooks.Add (xlWBATWorksheet)
        iSource.Copy .ActiveWorkbook.Worksheets(1).Range("A1")
        Set iSource = Nothing
        .ActiveWorkbook.SaveAs iFileName, xlText ', Local:=True
        .ActiveWorkbook.Close False
        .DisplayAlerts = True: .ScreenUpdating = True
    End With

Dim iSource As Range, iFileName
    Set iSource = ActiveSheet.Range("A1:D1000")
   
    With Application
         iFileName = .GetSaveAsFilename( _
         FileFilter:="Text Files (*.txt), *.txt", _
         Title:="Выберите имя файла и место для его сохранения")
         If iFileName <> False Then
            .ScreenUpdating = False
            .DisplayAlerts = False '
            With .Workbooks.Add(xlWBATWorksheet)
                 iSource.Copy Destination:=.Worksheets(1).Range("A1")
                 .Close Filename:=iFileName, saveChanges:=True
            End With
            .DisplayAlerts = True '
            .ScreenUpdating = True
         Else
            MsgBox "Для сохранения данных неоходимо указать файл", , ""
         End If
    End With