Написать процедуру на VBA
Пусть исходный файл называется stranico.xls, лист "Sheet1" (В русской локализации Microsoft Escel как привило "Лист 1")
Созданные файлы нужно копировать в папку D:\SHEETS\ и называть от 0.xls до 50.xls
Макрос для копирования заголовка через каждую 1000 строк:
Sub Переброска_заголовков()
Dim n As Long
Dim i As Long
i = 1
For n = 0 To 49
Rows("1:1").Select
Selection.Copy
i = i + 1
Rows(((n + 1) * 1000 + i) & ":" & ((n + 1) * 1000 + i)).Select
Selection.Insert Shift:=xlDown
Next n
End
Макрос для копирования по 1000 строк и создания файлов:
Sub Porezka()
Dim n As Long
Dim i As Long
i = 1
For n = 0 To 50
Rows((n * 1000 + i) & ":" & ((n + 1) * 1000 + i)).Select
i = i + 1
Selection.Copy
Sheets("Sheet1").Select
Sheets.Add
ActiveSheet.Rows("1:1001").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ActiveSheet.Select
ActiveSheet.Paste
ActiveSheet.Select
Application.CutCopyMode = False
ActiveSheet.Move
' -------------------------------- Это можно убрать - форматирования файла. Или дописать самому визуально
Columns("D:D").Select
Selection.Locked = False
Selection.FormulaHidden = False
Range("E7").Select
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").ColumnWidth = 32.29
Columns("C:C").ColumnWidth = 34.43
Columns("D:D").ColumnWidth = 39.71
Columns("E:E").Select
Selection.EntireColumn.Hidden = True
Columns("F:F").Select
Selection.Locked = False
Selection.FormulaHidden = False
Range("C6").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True
'-----------------------------------------------------------
ActiveWorkbook.SaveAs Filename:="D:\SHEETS\" & n & ".xls", FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWorkbook.Close
Windows("stranico.xls").Activate
Sheets("Sheet1").Select
Next n
End
End Sub
- Войдите или зарегистрируйтесь, чтобы получить возможность отправлять комментарии