astoryМне подсказали этот кодСкажите тому, кто подсказал этот код, чтобы забыл про ActiveWorkbook. Может в каких-то версиях это работает, у меня - нет. А также, не забывал вернуть Application.ScreenUpdating на место, а то будет очень весело.
Переделал код универсально и добавил изменение ширины столбцов
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
Sub DivFile()
Dim i As Long, j As Integer, s As String, ws As Worksheet, NewWB As Workbook
Application.ScreenUpdating = False
Set ws = ActiveSheet
For i = 1 To ws.UsedRange.Row + ws.UsedRange.Rows.Count - 1 Step 46
Set NewWB = Workbooks.Add(xlWBATWorksheet)
ws.Rows(i & ":" & i + 45).Copy NewWB.Worksheets(1).Range("A1")
For j = 1 To 14
NewWB.Worksheets(1).Columns(j).ColumnWidth = ws.Columns(j).ColumnWidth
Next
s = Replace(ThisWorkbook.FullName, ".xls", "-" & (Fix(i / 46) + 1) & ".xls")
NewWB.SaveAs s
NewWB.Close
Set NewWB = Nothing
Next
Application.ScreenUpdating = True
End Sub
