A1から入力されていることを前提に書いています。
また、テンプレートが無いことを前提に書いています。
Sub Substitution()
'CellD:セルに入力された行数
'i:Forで使用
'P:Sheet2の行数管理に使用
Dim CellD, i, P As Integer
P = 1
'SheetName:シートの名前を代入
Dim SheetName As String
SheetName = ThisWorkbook.ActiveSheet.Name
'行数の代入
CellD = Range("A1").CurrentRegion.End(xlDown).Row
For i = 1 To CellD Step 7
If CellD - i > 7 Then
Range("A" + CStr(i) + ":A" + CStr(i + 6)).Select
Selection.Copy
Sheets("Sheet2").Select
Range("A" + CStr(P)).Select
ActiveSheet.Paste
P = P + 7
Range("A" + CStr(P)).Select
'改行
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
Sheets(SheetName).Select
Else
Range("A" + CStr(i) + ":A" + CStr(CellD)).Select
Selection.Copy
Sheets("Sheet2").Select
Range("A" + CStr(P)).Select
ActiveSheet.Paste
'改行
Range("A" + CStr(CellD + 1)).Select
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
End If
Next
End Sub
お礼
お礼が遅くなりました どうもありがとうございました