Experimente este código:
Sub Test()
TitleRow = 1 'if title contain more than one row, change the value 1 to the actual number of rows
i = 0
Application.DisplayAlerts = False
Do
Set StartCell = ActiveSheet.Range("A" & (TitleRow + 3 * i + 1))
Set EndCell = ActiveSheet.Range("A" & (TitleRow + 3 * i + 3))
With ActiveSheet.Range(StartCell, EndCell)
.Merge
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
End With
i = i + 1
Loop Until Range("A" & (TitleRow + 3 * i) + 1) = ""
Application.DisplayAlerts = True
End Sub