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

[大灰狼1976]

Hi abhay!
There should be no problem with the code.
Can you post the target file and one of source files?


--Okami

[abhay_547]

I can't share the source files due to huge volume of data but I can explain you the exact issue. For e.g. if the copy range in a sheet is A1:E2000 then the paste range should also be mentioned as A1:E2000 only then the above macro code works as expected else if you mention just A1 as cell for paste range then it will copy only the cell A1 content from source worksheet to target worksheet, I don't want to keep a specific range instead I want to copy all the data from the source worksheet into target worksheet so need to amend the above code for the same.

[abhay_547]

Any luck ? did anyone get the chance to look into the above code.