Добрый вечер! Помогите, пожалуйста, оптимизировать макрос по объединению ячеек в столбцах с одинаковыми данными.  
Сейчас я использую следующий макрос:  
Sub Merge()  
'  
' Merge Macro  
' For Channel Report  
'  
   rc = Selection.Rows.Count  
   cc = Selection.Columns.Count  
   If rc > 1 Then  
   For i = 1 To cc  
     For j = 1 To rc  
      If Selection.Cells(j, i).MergeCells Then  
        tmpval = Selection.Cells(j, i).Value  
        Set tmpar = Selection.Cells(j, i).MergeArea  
        Selection.Cells(j, i).MergeArea.UnMerge  
        tmpar.Value = tmpval  
      End If  
     Next  
   Next  
   For i = 1 To cc  
     oz = Selection.Cells(1, i).Value  
     tomerg = False  
     For j = 2 To rc  
       If Selection.Cells(j, i).Value = oz Then  
         If tomerg = False Then  
           tomerg = True  
           fcv = oz  
           fromi = i  
           fromj = j - 1  
         End If  
       Else  
         If tomerg = True Then  
           tmpval = Selection.Cells(fromj, i).Value  
           Range(Selection.Cells(fromj, i), Selection.Cells(j - 1, i)).Clear  
           Range(Selection.Cells(fromj, i), Selection.Cells(j - 1, i)).Merge  
           With Selection.Cells(fromj, i)  
               .HorizontalAlignment = xlRight  
               .VerticalAlignment = xlTop  
               .WrapText = False  
               .Orientation = 0  
               .AddIndent = False  
               .IndentLevel = 0  
               .ShrinkToFit = False  
               .ReadingOrder = xlContext  
               .MergeCells = True  
               .Value = tmpval  
           End With  
         End If  
         tomerg = False  
         oz = Selection.Cells(j, i).Value  
       End If  
     Next  
         If tomerg = True Then  
           tmpval = Selection.Cells(fromj, i).Value  
           Range(Selection.Cells(fromj, i), Selection.Cells(j - 1, i)).Clear  
           Range(Selection.Cells(fromj, i), Selection.Cells(j - 1, i)).Merge  
           Selection.Cells(fromj, i).Value = tmpval  
           With Selection.Cells(fromj, i)  
               .HorizontalAlignment = xlRight  
               .VerticalAlignment = xlTop  
               .WrapText = False  
               .Orientation = 0  
               .AddIndent = False  
               .IndentLevel = 0  
               .ShrinkToFit = False  
               .ReadingOrder = xlContext  
               .MergeCells = True  
               .Value = tmpval  
           End With  
         End If  
         tomerg = False  
   Next  
   End If  
     
           MsgBox ("Усе!")  
End Sub  
 
Очень хотелось бы его ускорить, добавить форматирование ячеек по центру (по горизонтали и вертикали) и текст делать 10-ым шрифтом, либо оставлять начальное форматирование текста без изменений.