Sub Export_Selection_Into_Txt()   ' экспорт выбранных диапазонов в текстовой файл
      Dim rArea As Range, i&, j&, X, Y, Z$, FileName
      For Each rArea In Intersect(ActiveSheet.UsedRange, ActiveWindow.RangeSelection).Areas
      X = rArea.Value ' диапазон —> в массив
      If Not IsArray(X) Then ' если это не массив, то значит одна ячейка
          Y = X
      Else
          ReDim Y(1 To UBound(X))
          For i = 1 To UBound(X)
              For j = 1 To UBound(X, 2) ' собираем значения по ячейкам строк с разделителями vbTab
                  Y(i) = Y(i) & IIf(j = 1, "", vbTab) & X(i, j)
              Next j
          Next i
          Y = Join(Y, vbCrLf) ' собираем строки с разделителем vbCrLf
      End If
      Z = Z & Y & vbCrLf & "-----------" & vbCrLf ' собираем области с разделителем vbCrLf & "-----------" & vbCrLf
      Next rArea
      'Debug.Print Z
      X = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")) & "txt"
      FileName = Application.GetSaveAsFilename(InitialFileName:=X, FileFilter:="Text Files (*.txt), *.txt")
      If VarType(FileName) = vbBoolean Then Exit Sub       ' если нажали "Отмена", то FileName = False
      FileName = Left(FileName, InStrRev(FileName, ".")) & "txt"
      With CreateObject("Scripting.FileSystemObject")
      With .CreateTextFile(FileName, True): .Write Y: .Close: End With
      End With
      MsgBox "Выбранный диапазон экспортирован в файл" & vbCrLf & FileName, 64, "Экспорт выполнен успешно!"
End Sub