автоматическое создание листа

[nub]

знатоки, помогите новичку!!!
задача такая:
необходим цикл-
есть лист1, на нём столбец исходных данных,
этот столбец произвольной длины { A(i):A(n)}
необходимо
создать лист2, перенести данные А1:А5 на лист2,
создать лист3, перенести данные А6:А10 на лист3
и тд, пока все данные с первого листа не перенесутся...
Заранее благодарю...

[Diment]

Код: Выделить всё

Sub addList()
    Application.ScreenUpdating = False
    shCount1 = Application.WorksheetFunction.RoundUp(Sheets(1).Cells(65000, 1).End(xlUp).Row / 5, 0)
        For i = 1 To shCount1
            shCount = Sheets.Count
            Sheets.Add After:=Sheets(shCount)
            ActiveSheet.Name = "Лист" + Trim(Str(shCount + 1))
            For j = 1 To 5
                Sheets(i + 1).Cells(j, 1).Value = Sheets(1).Cells((i * 5) - 5 + j, 1).Value
            Next j
        Next i
        Sheets(1).Select
    Application.ScreenUpdating = True
End Sub

[Pavel55]

Вот ещё вариант

Код: Выделить всё

Sub AddSheets()
Dim iLastRow As Long, i As Long, n As Long
Dim NewSht As Worksheet
Dim SourceSht As Worksheet

    iLastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
    Set SourceSht = ActiveSheet
    Application.ScreenUpdating = False
    For i = 0 To iLastRow Step 5
        n = n + 1
        Set NewSht = Sheets.Add
        SourceSht.Range(SourceSht.Cells(i + 1, 1), SourceSht.Cells(i + 5, 1)).Copy Destination:=NewSht.Range("A1")
        NewSht.Name = "Часть " & n
    Next
    Application.ScreenUpdating = True
    SourceSht.Activate
    MsgBox "Создано " & n & " листа (ов)", vbInformation, ""
End Sub