Sub RowsNum()   'нумерация ячеек в выделенном столбце Selection
     If TypeName(Selection) <> "Range" Then Exit Sub
     On Error Resume Next
     If Selection.Columns.Count <> 1 Then MsgBox "Выбрано более одного столбца": Exit Sub
     Dim iCell As Range
     Dim Nn: Nn = Selection.Cells(1)
     Application.ScreenUpdating = False
     For Each iCell In Selection
        With iCell
           If (Not .MergeCells) Or (.MergeCells And .Address = .MergeArea.Cells(1).Address) Then
              .Value = Nn: Nn = Nn + 1
'            .NumberFormat = Selection.Cells(1).NumberFormat
'            .HorizontalAlignment = Selection.Cells(1).HorizontalAlignment
'            .VerticalAlignment = Selection.Cells(1).VerticalAlignment
'            .Orientation = Selection.Cells(1).Orientation
'            .ShrinkToFit = Selection.Cells(1).ShrinkToFit
           End If
        End With
     Next
     Application.ScreenUpdating = True
End Sub