Excel Macro: Lose line breaks pasting multiple (non-adjacent) rows into a different workbook - excel

Question

This is odd, because it doesn't always happen as described here.
This Macro allows me to select multiple (non-adjacent) rows in any Workbook or Worksheet, copy them to clipboard and delete the rows.
Sub CopytoClipboardandDelete()
Dim obj As New MSForms.DataObject
Dim X, str As String
Dim count As Integer
count = 0
For Each X In Selection
count = count + 1
If X <> "" Then
If count = 1 Then
str = str & X
Else
str = str & Chr(9) & X
End If
End If
If count = 16384 Then
str = str & Chr(13)
count = 0
End If
Next
obj.SetText str
obj.PutInClipboard
Selection.Delete Shift:=xlUp
End Sub
Now, often, when I get to the Active Workbook or Worksheet to paste the row values the row line breaks are lost and all the data goes into the first single row.
Since this occurs so often, I setup a Macro to easily deal with this.
The problem is that this ONLY works when I happen to paste from the clipboard into a blank Worksheet with all the row data now in Row 1.
If I manually insert 4 rows in the other Worksheet or Workbook at a random point, say into Row 20 to Row 24, since there's 4 rows of data in the clipboard; of course this Macro won't work.
Sub FixAllOnLine1OneRowAtATimeToFirstEmpty()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = ActiveSheet
Set pasteSheet = ActiveSheet
copySheet.Range("Q1:AF1").Copy
pasteSheet.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
Columns("Q:AF").Select
Selection.Delete Shift:=xlToLeft
End Sub
This solution is also close, but again lacks the random flexibility.
Split single row into multiple rows based on cell value in excel
So potentially I'm looking for either solution or both if possible. I am oddly curious why certain times pasting from the clipboard using the Sub CopytoClipboardandDelete the rows preserve their line breaks.
I have a clue to when this occurs, but no idea why. When I use the Sub CopytoClipboardandDelete from the source file that was saved as a text file (.txt or .csv) I rarely lose the row line breaks. But when I use the Sub and paste to a new workbook or worksheet, then use the Sub again from this new dataset and paste it on to another new workbook or worksheet it loses the row line-breaks nearly every time.

Answer 1

UPDATE: When using the Tab delimiter setting, I replace all the preexisting Tabs with 4 spaces.
Copy multiple (non-adjacent) ranges to Clip Board as Comma, Tab Or HTML Delimited Table
Notes:
Areas outside the worksheets UsedRange are cropped from source ange
Each Area in the source range is is broken into rows. Range("C1:D1,F1") will result in 2 rows C1:D1 and F1. 8:8,4:4,6:6 will add 3 rows with the first row being row 8 followed by row 4 and finally row 6.
Sample Data
Option Explicit
Enum ClipTableEnum
eCSV
eHTML
eTab
End Enum
Sub PutRangeIntoClipBoard(rSource As Range, Optional clipEnum As ClipTableEnum = eTab, Optional DebugPrint As Boolean = False)
Dim a, arr
Dim x As Long, rwCount As Long
Dim r As Range, rngRow As Range
Dim s As String
With rSource.Worksheet
Set r = Intersect(rSource, .UsedRange)
If InStr(r.Address(False, False), ",") Then
arr = Split(r.Address(False, False), ",")
Else
ReDim arr(0)
arr(0) = r.Address(False, False)
End If
For Each a In arr
rwCount = .Range(a).Rows.count
For x = 1 To rwCount
Set rngRow = .Range(a).Rows(x)
s = s & get1dRangeToString(rngRow, clipEnum)
Next
Next
End With
If DebugPrint Then Debug.Print vbCrLf & s
PutInClipBoard s
End Sub
Function get1dRangeToString(rSource As Range, Optional clipEnum As ClipTableEnum = eTab) As String
Dim arr
Dim s As String
Dim x As Long
If rSource.Cells.count = 1 Then
ReDim arr(0)
arr(0) = rSource.Value
Else
arr = WorksheetFunction.Transpose(rSource)
arr = WorksheetFunction.Transpose(arr)
End If
Select Case clipEnum
Case ClipTableEnum.eCSV
s = """" & Join(arr, """,""") & """" & vbCrLf
Case ClipTableEnum.eHTML
s = "<TR><TD>" & Join(arr, "</TD><TD>") & "</TD></TR>" & vbCrLf
Case ClipTableEnum.eTab
For x = LBound(arr) To UBound(arr)
arr(x) = Replace(arr(x), vbTab, " ")
Next
s = Join(arr, vbTab)
s = s & vbCrLf
End Select
get1dRangeToString = s
End Function
Sub PutInClipBoard(s As String)
Dim clip As DataObject
Set clip = New DataObject
clip.SetText s
clip.PutInClipBoard
Set clip = Nothing
End Sub

Answer 2

Ok I got it to work, sort-of. Now I can highlight any row that has the multiple rows pasted in; e.g. Highlight Row 10 with Row A10-P10 + Row Q10-AF10 + Row AG10-AV10 etc...and it copies Column Q10-AF10, inserts into Column A11-P11 and deletes Columns("Q:AF").
What I need the Macro to do is loop this process until there's no data outside Column A-P.
Sub FixAllOnLine1OneRowAtATimeInsertToNextRow()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = ActiveSheet
Set pasteSheet = ActiveSheet
copySheet.Range("Q" & ActiveCell.Row & ":AF" & ActiveCell.Row).Copy
Range("Q" & ActiveCell.Row & ":AF" & ActiveCell.Row).Offset(1).Select
pasteSheet.Cells(ActiveCell.Row, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
Columns("Q:AF").Select
Selection.Delete Shift:=xlToLeft
End Sub