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
