VBA which opens a workbook in another folder base on a list of names in your current workbook

[ExcelNovice_]

So I have a workbook open . In a control sheet, It has an array of names like

Apple
Orange
Pear

The same workbook but has multiple worksheets and the sheets itself are named apple, orange and pear.

In another folder,i have excel files with the exact same names.

How do i go about writing a macro to loop through the names in the control, to open the file with the same name in another folder and copy the data over?

In sequence :
1. It detects the range of items from wb1.ws1
2. Loop through the first item apple.
3. Opens a worksheet entitled apple in the folder
4. Copy the data
5. Paste in apple worksheet in wb1

 

[Larry Haydn]

1. Data source workbooks are saved in C:\DataFolder\
Apple.xlsx, Orange.xlsx, Pear.xlsx
2. Destination workbook has to be saved as a macro-enabled workbook (*.xlsm or *.xlsb)
Make sure you allow the system to run macros:

Here is the destination workbook set-up:

And here is the code:

Option Explicit
Option Compare Text

Sub CopyData()
'=============================================
'   Loop through the list of workbook names
'   and copy data into this workbook
'=============================================
Dim WB As Workbook      'This workbook
Dim LST As Worksheet    'This workbook

Dim xWB As Workbook     'External workbook
Dim xWS As Worksheet    'External workbook

Dim RowNo As Long

Dim FN As String        'Data source filename
Dim FLDR As String      'Folder name
Dim FEXT As String      'Filename extension
Dim FPATH As String     'Full Path

    Application.ScreenUpdating = False
    
    '======================================================
    '   First, identify this workbook and its worksheets
    '======================================================
    Set WB = ActiveWorkbook
    Set LST = WB.Sheets("DataSource")

        '===============================================
        '   Get the:
        '   * data source folder name
        '   * data file name
        '   Make sure the folder name ends with a "\"
        '===============================================
        FLDR = LST.Range("C2")
        FEXT = LST.Range("E2")
        
            '=================================================
            '   Next, loop through the list of data sources
            '=================================================
            RowNo = 2
            
            Do
                '======================================================
                '   Get the data source filename
                '   Trim() = remove any leading- and trailing-spaces
                '======================================================
                FN = Trim(LST.Range("A" & RowNo))
                    '========================
                    '   Form the full path
                    '========================
                    FPATH = FLDR & FN & FEXT
                    Application.StatusBar = "Copying data from: " & FPATH
                    '=================================
                    '   Open the file, if it exist
                    '==================================
                    If Not Dir(FPATH) = "" Then
                        '============================
                        '   Open the data workbook
                        '============================
                        Workbooks.Open FPATH
                            '================================
                            '   Identify the data workbook
                            '================================
                            Set xWB = ActiveWorkbook
                            Set xWS = xWB.Sheets("Sheet1")
                            '=======================================================
                            '   Clean up the destination worksheet before pasting
                            '=======================================================
                            WB.Sheets(FN).Cells.ClearContents
                            '===================
                            '   Copy the data
                            '===================
                            xWS.Range("A1").CurrentRegion.Copy Destination:=WB.Sheets(FN).Range("A1")
                        '=============================
                        '   Close the data workbook
                        '=============================
                        xWB.Close
                        
                    End If
                '======================
                '   Next data source
                '======================
                RowNo = RowNo + 1
                
            Loop Until LST.Range("A" & RowNo) = ""
    
    '========================
    '   Save this workbook
    '========================
    WB.Save
    Application.StatusBar = "Data files have been copied."
    Application.ScreenUpdating = True
    
End Sub