こんな感じ。
┌──────────────────────────────────────┐
│Dim 範囲 As Range                                                           │
│Dim y出 As Long, y入 As Long                                                │
│With Range(入力シート.PageSetup.PrintArea)                                  │
│    If .Item(.Count).Row = 1 Then                                           │
│        MsgBox "印刷範囲を拡大してください。", vbExclamation, "処理の中止"  │
│        Exit Sub                                                            │
│    End If                                                                  │
│    If .Item(1).Row = 1 Then                                                │
│        Set 範囲 = Range(.Item(2, 1), .Item(.Count))    ' ヘッダ行を除く    │
│    Else                                                                    │
│        Set 範囲 = Range(.Item(1), .Item(.Count))                           │
│    End If                                                                  │
│End With                                                                    │
│With 出力シート                                                             │
│    ' 転記するために行挿入(2行目以降に)                                     │
│    Application.CutCopyMode = False     ' コピー中のバッファをクリア        │
│    .Rows(2).Resize(範囲.Rows.Count).Insert _                               │
│                                        Shift:=xlDown, _                    │
│                                        CopyOrigin:=xlFormatFromRightOrBelow│
│    ' 転記                                                                  │
│    y出 = 2                                                                 │
│    For y入 = 範囲.Rows.Row To 範囲.Rows.Row + 範囲.Rows.Count - 1          │
│        .Cells(y出, x).Value = 入力シート.Cells(y入, x).Value               │
│        y出 = y出 + 1                                                       │
│    Next y入                                                                │
│End With                                                                    │
└──────────────────────────────────────┘