任意の期間を地湧出して別シートにデータを転記して、最終行の下に合計を出したいですがコードを教えていただけないでしょうか。

バイト社員の勤務記録から給料明細をつくるものです。
ブックのシート構成は・・・

各自の勤務を記録した個人別シートで複数あります。ここでは【山田太郎】です。
この中から【印刷用】シートに名前と期間を入力するとデータを抽出して最終行の下に合計を出せないでしょうか。

【印刷用】シートの対象期間は
始まり・・・B1
終わり・・・D1

対象者名は・・・F5に入力されます。←この名前のシート名のデータを転記

不躾ですがどなたか教えていただけないでしょうか。


【山田太郎】シート

     A        B           C      D         E          F
3   年月日  開始時間   終了時間	休憩	勤務時間   合計額/日   
4   12/16     9:00	12:00		  3H	     3,000
5   01/06     9:00	12:00		  3H	     3,000
6   01/15     9:00	12:00		  3H	     3,000


【印刷用】シート

     A          B          C          D          E        F
5 　　　　　　　　　　　　　　　　　　　　　　　　　　山田太郎

7   年月日    開始時間   終了時間  休憩時間   勤務時間	日額
8   6(木)	9:00	   12:00	         3H     3,000
9  15(土)	9:00	   12:00	         3H     3,000
10  合計                                         6H     6,000                                  

Sub Shift()
    Dim WsPrn As Worksheet
    Dim BaseD, Dys, NM
    Dim i As Long, iOut As Long
    
    Set WsPrn = Worksheets("印刷用")
    
    Application.ScreenUpdating = False
    
    With WsPrn
        BaseD = .Range("B1:D1")
        NM = .Range("F5")
        .Range("A8").Resize(.UsedRange.Rows.Count, 6).ClearContents
    End With
    
    With Worksheets(NM)
        Dys = .Range("A4").Resize(.UsedRange.Rows.Count).Value
        iOut = 7
        
        For i = 1 To UBound(Dys)
            If BaseD(1, 1) <= Dys(i, 1) And Dys(i, 1) <= BaseD(1, 3) Then
                iOut = iOut + 1
                WsPrn.Cells(iOut, 1).Resize(1, 6) = .Cells(i + 3, 1).Resize(1, 6).Value
            End If
        Next i
        
        If iOut > 7 Then
            WsPrn.Cells(iOut + 1, "A") = "合計"
            WsPrn.Cells(iOut + 1, "F").FormulaR1C1 = "=SUM(R8C6:R[-1]C)"
        End If
    End With
    
    Application.ScreenUpdating = True
End Sub


この記事にはVBAのコードが含まれています。

緑の太文字→注釈
茶色の太文字→条件分岐
赤の太文字→ループ
青の太文字→その他