Sub Macro1()
    Dim rng As Range
    Dim cel As Range
    Set rng = Range("a2:a10")
    For Each cel In rng
        Range("j1").Value = cel.Value
        Range("j2").Value = cel.Offset(0, 1).Value
        Range("j3").Value = cel.Offset(0, 2).Value
        Range("J1:J3").Select
        Selection.PrintOut Copies:=cel.Offset(0, 3).Value
    Next cel
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo 10
Dim ur As Integer
Dim i As Integer
Application.ScreenUpdating = False
If Not Intersect(Target, Range("d2:d25")) Is Nothing Then
    For i = 1 To Target.Value
        ur = Cells(Rows.Count, 12).End(xlUp).Row
        Range("A" & Target.Row & ":" & "C" & Target.Row).Select
        Selection.Copy
        Range("L" & ur + 1).Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Next i
Application.CutCopyMode = False
End If
Target.Offset(1, 0).Select
10:
Application.ScreenUpdating = True
End Sub