merge cell vba macro

ActiveCell.Offset(1, 0).Select

Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 1)).Merge

ActiveCell.Select

-----------------------------------------------------

Dim foundFirst As Range

Dim foundOne As Range

Dim dataRRay As Variant

Dim searchIn As Range

Dim searchFor As String

Dim columnTo As Integer

columnTo = 8

searchFor = "table"

Set searchIn = Range("a:d")

Set searchIn = Application.Intersect(searchIn.Parent.UsedRange, searchIn)

ReDim dataRRay(0 To searchIn.Count)

Dim i As Long

i = 1

Set foundFirst = searchIn.Find(What:="*" & searchFor & "*", after:=searchIn.Range("a1"), _

LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _

SearchDirection:=xlNext, MatchCase:=False)

Set foundOne = foundFirst

Do

dataRRay(i) = foundOne.Value

i = i + 1

Set foundOne = searchIn.Cells.FindNext(after:=foundOne)

Loop Until foundOne.Address = foundFirst.Address

dataRRay(0) = dataRRay(i - 1)

ReDim Preserve dataRRay(i - 2)

With Sheets("destinationSheet")

Range(.Cells(1, columnTo), .Cells(i - 1, columnTo)) = Application.Transpose(dataRRay)

End With