Я же сказал, что уже поздно, не вернуть :)  
Имя ведь уже пропало.  
А в исходной таблице имя другое было.  
А качать заново и смотреть мне было лень, думал сами разберётесь если что.  
 
 
Option Explicit  
Private Sub qwerty()  
Dim RowIndex As Long  
Dim StartRow As Long  
Dim LastRow As Long  
Dim ColumnToMerge As Long  
StartRow = 2  
ColumnToMerge = 1  
LastRow = Cells(Rows.Count, ColumnToMerge).End(xlUp).Row  
Application.DisplayAlerts = False  
ActiveSheet.ListObjects("Таблица13").Unlist  
   For RowIndex = StartRow + 1 To LastRow  
       With Cells(RowIndex, ColumnToMerge)  
           If .Value = .Offset(-1, 0).MergeArea.Cells(1).Value Then  
           Range(Cells(RowIndex, ColumnToMerge), .Offset(-1, 0)).Merge  
           End If  
       End With  
   Next RowIndex  
Application.DisplayAlerts = True  
End Sub