Excel VBA CopyNPaste Multiple Values

Sub DatenAusQuelldateienKopieren()
    Dim QuellOrdner As String
    Dim AktiveMappe As Workbook
    Dim QuellArbeitsmappe As Workbook
    Dim Wochentag As String
    Dim ZeileH As Integer
    Dim ZeileI As Integer
    Dim ZeileJ As Integer
    
    QuellOrdner = "D:\"  
    
    Set AktiveMappe = ThisWorkbook
    
    Dim SubOrdner As Object
    Dim Datei As Object
    Dim Folder As Object
    
    Set SubOrdner = CreateObject("Scripting.FileSystemObject").GetFolder(QuellOrdner)  
    
    For Each Folder In SubOrdner.SubFolders
        For Each Datei In Folder.Files
            Set QuellArbeitsmappe = Workbooks.Open(Datei.Path)
            Dim ZielBlatt As Worksheet
            Wochentag = UCase(QuellArbeitsmappe.Sheets(1).Range("A2").Value)  
            For Each ZielBlatt In AktiveMappe.Sheets
                If Wochentag = ZielBlatt.Name Then
                    Select Case QuellArbeitsmappe.Sheets(1).Range("B2").Value  
                        Case "A"  
                            ZeileH = 6
                            ZeileI = 6
                            ZeileJ = 6
                        Case "B"  
                            ZeileH = 7
                            ZeileI = 7
                            ZeileJ = 7
                        Case "C"  
                            ZeileH = 8
                            ZeileI = 8
                            ZeileJ = 8
                        Case "D"  
                            ZeileH = 9
                            ZeileI = 9
                            ZeileJ = 9
                        Case "E"  
                            ZeileH = 10
                            ZeileI = 10
                            ZeileJ = 10
                        Case "F"  
                            ZeileH = 11
                            ZeileI = 11
                            ZeileJ = 11
                        Case "G"  
                            ZeileH = 12
                            ZeileI = 12
                            ZeileJ = 12
                        Case "H"  
                            ZeileH = 13
                            ZeileI = 13
                            ZeileJ = 13
                        Case "I"  
                            ZeileH = 14
                            ZeileI = 14
                            ZeileJ = 14
                        Case "J"  
                            ZeileH = 15
                            ZeileI = 15
                            ZeileJ = 15
                        Case "K"  
                            ZeileH = 16
                            ZeileI = 16
                            ZeileJ = 16
                        Case Else
                    End Select  
                    ZielBlatt.Range("H" & ZeileH).Value = QuellArbeitsmappe.Sheets(1).Range("F2").Value  
                    ZielBlatt.Range("I" & ZeileI).Value = QuellArbeitsmappe.Sheets(1).Range("F6").Value  
                    ZielBlatt.Range("J" & ZeileJ).Value = QuellArbeitsmappe.Sheets(1).Range("F10").Value  
                End If
            Next ZielBlatt
            QuellArbeitsmappe.Close SaveChanges:=False
        Next Datei
    Next Folder
End Sub