Sub Obyedenenie()
Dim LRow As Long, T As String
Application.ScreenUpdating = False 'отключаем обновление экрана
LRow = Cells(Rows.Count, 1).End(xlUp).Row 'последняя строка по 1 столбцу
For i = 26 To LRow
    T = Range("G" & i)
    With Range("C" & i & ":Q" & i)
        .ClearContents
        .MergeCells = True
        .Value = T
        .HorizontalAlignment = xlLeft
    End With
Next
Application.ScreenUpdating = True 'включаем обновление экрана
End Sub