I used print preview, but you can change this after you test.

Option Explicit
Sub testme01()

   Dim wks1 As Worksheet
   Dim wks2 As Worksheet
   Dim wks3 As Worksheet
   Dim AddrToCopy As String
   Dim AddrToPaste As String
   
   Set wks1 = Worksheets("sheet1")
   Set wks2 = Worksheets("sheet2")
   Set wks3 = Worksheets("sheet3")
   
   AddrToCopy = "D27:d40"
   AddrToPaste = "B27"
   
   With wks3
       Do
           If .Range(AddrToCopy).Cells(1).Value = "" Then
               Exit Do
           End If
           .Range(AddrToCopy).Copy _
               Destination:=.Range(AddrToPaste)
           .Range(AddrToCopy).Delete shift:=xlToLeft
           wks1.PrintOut copies:=4, preview:=True
           wks2.PrintOut copies:=1, preview:=True
       Loop
   End With
End Sub