Деление столбцов на равные части

[Serge_Bliznykov]

Сообщение от Viktorkv

Вроде с пустой строкой разобрался

Вы хотели сказать с пустым СТОЛБЦОМ?


попробуйте такой макрос.

Sub DelColumns()
    Dim i As Long, n As Integer, j As Long, ColCount As Integer: Application.ScreenUpdating = False
    Sheets("Было").Activate: Sheets("Стало").Cells.ClearContents
    n = InputBox("Введите количество частей", "Ввод")
    If n < 1 Then Exit Sub
    j = Fix(Cells(Rows.Count, 1).End(xlUp).Row / n)
    If j < 2 Then Exit Sub
    ColCount = 1
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row Step j
        'Cells(i, 1).Resize(j, 3).Copy Sheets("Стало").Cells(1, ColCount)
        Cells(i, 1).Resize(j, 3).Copy
        With Sheets("Стало").Cells(1, ColCount)
            .PasteSpecial xlPasteColumnWidths
            .PasteSpecial xlPasteValues, , False, False
            .PasteSpecial xlPasteFormats, , False, False
        End With
        Application.CutCopyMode = False
        Sheets("Стало").Columns(ColCount + 3).ColumnWidth = 8
        ColCount = ColCount + 4
    Next
End Sub

[Viktorkv]

Спасибо!