1480      If afSh = 1 Then
1490          fRow = 40 ' с какой строки искать
1500          afCol = 3 ' сколько столбцов объединены
1510      Else
1520          fRow = 32
1530          afCol = 4
1540      End If

1550      Set sh = Sheets(afSh)
1560      Set coll = New Collection
1570      colW = 0
1580      For ii = afCol To afCol + 2
1590          colW = colW + sh.Columns(ii).ColumnWidth
1600      Next

1610      sh.Copy after:=Sheets(Sheets.Count)

1620      With Sheets(Sheets.Count)
1630          .Columns(afCol).ColumnWidth = colW
1640          .Columns(afCol).ColumnWidth = .Columns(afCol).ColumnWidth * _
                    sh.Range(sh.Columns(afCol), sh.Columns(afCol + 2)).Width / .Columns(afCol).Width
1650          For ii = fRow To itogRow
1660              If .Cells(ii, 4).MergeArea.Columns.Count = 3 Then
1670                  coll.Add ii
1680              End If
1690          Next
1700          With .Range(.Cells(fRow, afCol), .Cells(itogRow, afCol))
1710              .UnMerge
1720              .EntireRow.AutoFit
1730          End With
1740          For Each valColl In coll
1750              If sh.Rows(valColl).RowHeight <> .Rows(valColl).RowHeight Then
1760                  sh.Rows(valColl).RowHeight = .Rows(valColl).RowHeight
1770              End If
1780          Next
1790          Set coll = Nothing

1800          Application.DisplayAlerts = False
1810          Sheets(Sheets.Count).Delete
1820          Application.DisplayAlerts = True
1830      End With