Merging non-blank cells with blank cells below

Question

I have a worksheet with the following layout:

Column title
Data1
              <- blank cell 1
              <- blank cell 2   
Data2
Data3
Data4
              <- blank cell 3
              <- blank cell 4
              <- blank cell 5
Data5

I want to merge the blank cells along with the "data" right above.

For example:
"blank cell 1" and "blank cell 2" should be merged with cell Data1
"blank cell 3", "blank cell 4", and "blank cell 5" should be merged with cell Data4.

The end product should have the following layout:

Column title
Data1
              <- part of Data1, result of a merge
              <- part of Data1, result of a merge   
Data2
Data3
Data4
              <- part of Data4, result of another merge
              <- part of Data4, result of another merge
              <- part of Data4, result of another merge
Data5

I tried to probe where the merging should start by calculating an offset of the number of Data cells, then activate the cell right where the condition ActiveCell.Value <> "" becomes false.
I realized that I don't know how to change the location of the active cell, and if I keep using offsets, it would not work when I try to do a second merge, as the offset is a single selection.

Cell("C3").Activate      'C3 is the Column title
Dim offset As Variant

While True:
    offset = 0
    While (ActiveCell.Value <> ""):    'I am trying to skip over the cells with contents
        offset = offset + 1
    Wend
    ' Here, ActiveCell.offset(offset - 1, 0) should give me the Data cell that I should merge with the blank cells below (to be calculated with a second loop), but I'm not sure how to make that cell the active cell.
Wend

Answer 1

Merge any blank cell found with the cell above it.

    Dim i As Long
    Dim lr As Long
    Dim lastdata As Long
    
    With Sheets("Sheet1")'Change to your sheet name
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To lr 
            If .Cells(i, 1).Value = "" Then
                .Range(.Cells(i, 1).Offset(-1), .Cells(i, 1)).Merge
            End If
        Next i
    End With