Офис

    Sub DivFile()
    Dim i As Long, s As String, ws As Worksheet
    Application.ScreenUpdating = False: Set ws = ActiveSheet
    For i = 1 To ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1 Step 500
    Workbooks.Add xlWBATWorksheet: ws.Rows(i & ":" & i + 499).Copy [A1]
    s = Replace(ThisWorkbook.FullName, ".xls", "-" & (Fix(i / 500) + 1) & ".xls")
    ActiveWorkbook.SaveAs s: ActiveWorkbook.Close
    Next
    End Sub

     

    Макрос для выгрузки отдельного листа книги Excel в файлы с разбивкой по количеству строк (в данно случае 500).

    Tags:

    Main Menu