Excel Macro to copy data from a specified multiple ranges of a workbook to another wb

[abhay_547]

I have this below macro which was built to copy data from one workbook excel sheet range to another workbook excel sheet range. Below is how it would work..

Files:
Workbook1: Macro File - this file consists of the names of the source workbooks, worksheet names in source workbook and data range which needs to be copied from those worksheet. It also consists of the same details of target workbook to paste the data
Workbook2: Source Data Workbook
Workbook3: Target Data workbook

Issue:Issue is in the line highlighted in RED in the below code .i.e. it just copies and pastes one cell of data from source workbook instead of entire range and copies the same one cell value into the entire range of the target workbook's worksheet range.

Sub copy_data_from_multiple_wb()      
    Dim tmp_wb As Workbook, source_wb As Workbook 
    Dim LastRow As Long, i As Long, calc As Long 
    Dim fName As String, fPath As String 
    Dim CopyWS As String, CopyRng As String 
    Dim PasteWS As String, PasteRng As String 
     
    With Application 
        .DisplayAlerts = False 
        .ScreenUpdating = False 
        .EnableEvents = False 
        .AskToUpdateLinks = False 
        calc = .Calculation 
        .Calculation = xlCalculationManual 
    End With 
     
    With ThisWorkbook.Worksheets("Sheet1") 
        LastRow = .Range("A" & Rows.Count).End(xlUp).Row 
         
        On Error Resume Next 
        Set tmp_wb = Workbooks(.Range("F1").Value & .Range("D1").Value) 
        If Err Then 
            Err.Clear 
            Set tmp_wb = Workbooks.Open(.Range("F1").Value & .Range("D1").Value) 
        End If 
        On Error GoTo 0 
         
        For i = 4 To LastRow 
            fName = .Range("A" & i).Value 
            fPath = .Range("B" & i).Value 
            CopyWS = .Range("C" & i).Value 
            CopyRng = .Range("D" & i).Value 
            PasteWS = .Range("E" & i).Value 
            PasteRng = .Range("F" & i).Value 
            If Dir(fPath & fName) <> "" Then 'file exists
                Set source_wb = Workbooks.Open(fPath & fName) 
                tmp_wb.Worksheets(PasteWS).Range(PasteRng).Value = source_wb.Worksheets(CopyWS).Range(CopyRng).Value 
                .Range("G" & i).Value = "File Available. Data Copied" 
            Else 'file does not exist
                .Range("G" & i).Value = "File Not Available" 
            End If 
             On Error Resume Next
            Workbooks(source_wb).Close 
        Next 
    End With 
     
    With Application 
        .EnableEvents = True 
        .AskToUpdateLinks = True 
        .Calculation = calc 
        .StatusBar = False 
    End With 
     
End Sub