Sub MergeCells() StartRow = Selection.Row EndsRow = Selection.Rows.Count StartCol = Selection.Column EndsCol = Selection.Columns.Count StartCol0 = StartCol EndsCol0 = EndsCol Count = CInt(InputBox("Ââåäèòå êîë-âî áàíêîâ: ")) Debug.Print Count Colincriment = Round((EndsCol - Count - StartCol) / Count) Colincriment0 = Colincriment Application.ScreenUpdating = False For Row = StartRow To EndsRow + StartRow For i = 1 To Count If i = 1 Then StartCol = StartCol If i > 1 Then StartCol = StartCol + 1 Range(Cells(Row, StartCol), Cells(Row, StartCol + Colincriment)).Select With Selection .HorizontalAlignment = xlGeneral .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = True End With StartCol = StartCol + Colincriment If i = (Count - 1) Then Colincriment = EndsCol - StartCol + 2 End If Next i StartCol = StartCol0 EndsCol = EndsCol0 Colincriment = Colincriment0 Next Row Application.ScreenUpdating = True End Sub