Merge Title

Sub Step3_MergeTitle()
Attribute Step3_MergeTitle.VB_ProcData.VB_Invoke_Func = " \n14"
'
' MergeTitle Macro
'

'
'Where is Title
Dim i, n As Integer
Dim rangeSource As Range

n = Sheets.Count
i = 1
Do Until i > n
    Set wsSource = Worksheets(i)
    wsSource.Activate
    ' Detect range of content
    Set rangeSource = wsSource.UsedRange.SpecialCells(xlCellTypeVisible)

    With rangeSoucre
    Dim R, C As Long
    Dim Title As Range


        For C = 1 To rangeSource.Columns.Count
            For R = 1 To rangeSource.Rows.Count
            If Application.WorksheetFunction.IsText(rangeSource.Cells(R, C)) Then

            LastRow = rangeSource.Cells(R, C).End(xlDown).Row
            If LastRow > 4 Then
            LastRow = LastRow - 1
            End If
            Set Title = rangeSource.Range(Cells(R, C), Cells(LastRow, C))
            Exit For
            End If
            Next R
            If Application.WorksheetFunction.IsText(rangeSource.Cells(R, C)) Then
            Exit For
            End If
        Next C
        On Error Resume Next
        With Title
        Application.DisplayAlerts = False
        .UnMerge
        .Columns(1).ColumnWidth = 250
        .Justify
        Columns(1).ColumnWidth = 10
        End With

    End With
    i = i + 1
Loop

MsgBox "You have merge titles for all sheets"
End Sub