Issue selecting and merging cells after a row insert

I have a monthly calendar in excel, I can store 5 entries, when it comes to the 6th, I need to insert a complete row (which I can do)
However, the new row has 2 cells, I am struggling how to the select both cells in the new row below and merge them before entering text into the merged cell

I am basically finding the date cell which has a blank cell to the right, then using that cell to enter text in the merged cell (of which there are 5) below. I am then inserting a complete row below that but it has the 2 cells in the new row instead of being merged

For taskDateLooper = taskStartDate To taskEndDate

xlBook.Sheets(Format(taskDateLooper, "MMM yyyy")).Activate
Set xlSheet = xlBook.Sheets(Format(taskDateLooper, "MMM yyyy"))
'MsgBox (taskDateLooper)
strSearch = Format(taskDateLooper, "Short Date")
Set aCell = xlSheet.Range("A1:P36").Find(What:=strSearch)

aCell.Activate
' This basically adds text to the same cell with text on a new line
' Really this needs to add anotehr row in and then copy the task to
' the next cell down - THINK ABOUT HOW TO TRACK THIS OUT
' WE HAVE 5 CELLS AVAILABLE, REALLY ONLY NEED TO ADD ANOTHER ROW IF
' GO BEYOND 5 CELLS

If cellCounter > 5 Then

' MORE THAN 5 TASKS IN FOR THAT DATE, NEED TO ADD IN NEW ROW in table
aCell.Offset(cellCounter).EntireRow.Insert
' IN THE CALENDAR WE NEED TO MERGE WITH THE CELL TO THE RIGHT TO ENSURE THIS
' WORKS AND DOES NOT CAUSE TEXT TO DISAPPER IN THE CELL TO THE RIGHT
'???? THIS IS WHERE I AM STRUGGLING TO SELECT THE NEW CELLS BELOW AND MERGING THEM
'???? BEFORE THEN ENTERING THE TEXT

End If

If xlSheet.Cells(aCell.Row + cellCounter, aCell.Column).Value <> " " Then
xlSheet.Cells(aCell.Row + cellCounter, aCell.Column).Value = t.Name
Else
xlSheet.Cells(aCell.Row + cellCounter, aCell.Column).Value = t.Name
End If

cellCounter = cellCounter + 1

Next taskDateLooper

After

Please Login or Register  to view this content.

use this line

Please Login or Register  to view this content.