Sub test()
Dim Wks As Worksheet, a As Workbook
Dim HPB As HPageBreak, Lig&, i&, x&
Set a = Workbooks("dos.xls"): Set Wks = ActiveSheet: Lig = 2: i = 1
Application.ScreenUpdating = 0
Wks.[A1].CurrentRegion.Subtotal GroupBy:=3, Function:=xlSum, _
TotalList:=Array(7), Replace:=False, _
PageBreaks:=True, SummaryBelowData:=False
Wks.Range("A16").Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
For Each HPB In Wks.HPageBreaks
With Wks
x = HPB.Location.Row
.Range(.Cells(Lig, "A"), _
.Cells(x - 1, "B")).SpecialCells(2).Copy a.Sheets(i).[A21]
.Range(.Cells(Lig, "E"), _
.Cells(x - 1, "E")).SpecialCells(2).Resize(, 3).Copy a.Sheets(i).[C21]
End With
Lig = HPB.Location.Row: i = i + 1
Next HPB
ThisWorkbook.Close False
End Sub