Sub Glue_TXT_with_Chr10()   ' СКЛЕИТЬ тексты из выделенных ячеек с переносами строк
   If TypeName(Selection) <> "Range" Then Exit Sub
   Dim rRng As Range: Set rRng = Intersect(Selection, ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible))
   If rRng Is Nothing Then Exit Sub
   If rRng.Cells.Count = 1 Then Exit Sub
   Dim sText$, rCell As Range
   For Each rCell In Intersect(Selection, ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible))
      If Len(rCell.Value) Then sText = sText & IIf(Len(sText), vbLf, "") & rCell.Value
   Next rCell
   sText = Application.Trim(sText)
   With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}"): .SetText sText: .PutInClipBoard: End With
   MsgBox "Объединённый текст помещён в буфер обмена", , "Операция завершена успешно!"
End Sub