Merge rows in Excel & VBA - excel

Question

I want to merge rows in Excel: the content to merge can be in different columns, "C" or "D" in my example. Any way I can do this using VBA? The file has ~20k rows.
My File: http://i.imgur.com/yDPdaQC.png
Goal: http://i.imgur.com/SZ5t9oX.png
Edit with more details:
Some sentences from the C & D columns are divided in 2,3 and sometimes 4 rows. I would like to merge those strings at the "top" cell from their respective column, when "A" and "B" have a value.
Thanks for your help!

Answer 1

you can use this.
Sub Merge()
Dim ws As worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim ws2 As worksheet: Set ws2 = ThisWorkbook.Sheets("Sheet2")
Dim sheet2Rng As Range: Set sheet2Rng = ws2.UsedRange
Dim startRow As Integer: startRow = LastRow(ws) + 1
Dim ws2RowCount As Integer: sheet2Rng.Rows.Count
ChangeEvents False
ws.Range("A" & startRow).Resize(ws2RowCount, 4).value = sheet2Rng.value
ChangeEvents True
End Sub
Public Function LastRow(worksheet As worksheet) As Integer
LastRow = worksheet.Cells(Rows.Count, 1).End(xlUp).Row
End Function
Sub ChangeEvents(value As Boolean)
Application.EnableEvents = value
End Sub

Answer 2

Can you clarify? Are you trying to:
Create merged cells: C1 with D1, C2 with D2, etc? This will lose the contents of the D column.
Take the texts in column D and append them to the end of the column C cells;
Create a new column which contains the C + D appended texts

Answer 3

Something like this:
Sub SquishRows()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim rng As Range, rr As Range
Dim rowdata As Variant
Dim i As Integer, idx As Integer, j as Integer
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
sh1.Activate
Set rng = Range("A2").Resize(sh1.UsedRange.rows.Count - 1, sh1.UsedRange.Columns.Count)
ReDim rowdata(Application.CountA(rng.Columns(1)), rng.Columns.Count - 1)
idx = 0
For i = 1 To rng.rows.Count
Set rr = rng.rows(i)
If Len(rr.Cells(1).Text) And Len(rr.Cells(2).Text) Then
idx = idx + 1
For j = 1 To rng.Columns.Count
rowdata(idx, j - 1) = rr.Cells(j).Text
Next
Else
For j = 3 To rng.Columns.Count
If Len(rr.Cells(j).Text) Then
rowdata(idx, j - 1) = rowdata(idx, j - 1) & " " & rr.Cells(j).Text
End If
Next
End If
Next
'push data to Sheet2
sh2.Range("A1").Resize(UBound(rowdata, 1) + 1, UBound(rowdata, 2) + 1).Value = rowdata
'add in header row
sh2.Range(sh1.UsedRange.rows(1).Address).Value = sh1.UsedRange.rows(1).Value
sh2.Activate
End Sub