excel - What should I add in this macro if I want to remove blank cells?

Question

Sub CombineColumns()
Dim rng As Range
Dim iCol As Integer
Dim lastCell As Integer

Set rng = ActiveCell.CurrentRegion
lastCell = rng.Columns(1).Rows.Count + 1

For iCol = 2 To rng.Columns.Count
   Range(Cells(1, iCol), Cells(rng.Columns(iCol).Rows.Count, iCol)).Cut
   ActiveSheet.Paste Destination:=Cells(lastCell, 1)
   lastCell = lastCell + rng.Columns(iCol).Rows.Count
Next iCol
End Sub

---

This macro has been helpful for me to combine multiple columns in one cell. They may have been combined, my problem is that there are at least 5 blank rows between each data.

Here is the sample of my old data (uncombined yet) A B C 1 Single Married Married 2 Married Married 3 Single

Upon using the macro above, here is what happened: A B C 1 Single 2 3 4 5 6 7 Married 8 Maried 9 Single 10 11 12 13 14 15 Married 16 Married

The columns in my worksheet: A-SR ,which is a lot. If only I had a few, I can delete the blank rows manually.

How can I remove those blank rows, there must be something I can add in the macro above to combine multiple columns into one column, with data pasted continuously?

Thanks!