Retrieve a value from excel files in a Folder

[Dinesh_Excel]

Hello Friends,

Need your help where in I have an Excel(Master) with the names of file names.

The files (Test 1.xlms and Test 2.xlms ) are in some folder and has some value in "C9" in the worksheet "Widget".

Now the master file with the Files name should have the corresponding value of C9.

-----------------------------------------------------------------------------------------------------






Request for the help on the same.

 

[YasserKhalil]

Try this code

Sub Test()
    Dim wb          As Workbook
    Dim cl          As Range
    Dim myPath      As String

    myPath = ThisWorkbook.Path & "\Demo\" 'Change The Path To Suit

    Application.ScreenUpdating = False
        For Each cl In ThisWorkbook.Worksheets(1).Range("G2:G3")
            If cl.Value <> "" Then
                Set wb = Workbooks.Open(myPath & cl.Value, False)
                cl.Offset(, 1).Value = wb.Worksheets("Widget").Range("C9").Value
                wb.Close SaveChanges:=False
            End If
        Next cl
    Application.ScreenUpdating = True
End Sub

 

[Dinesh_Excel]

Thanks Yaseer, but some catch here.

while trying to add one more file "test3.xlsm" its not picking up the value in C9.
Appreciate your help here.

 

[Dinesh_Excel]

Sorry Yaseer ..my bad I should have changed the range ...

Appreciate your help..thank you very much.

 

[YasserKhalil]

You're welcome. Glad I can offer some help
Regards

 

[Marc L]

Hi !

Another way :​

Sub Demo1()
  Const E = ";Extended Properties=""Excel 12.0;HDR=NO""", P = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="
    Dim Cn As Object, Rg As Range, F$
    Set Cn = CreateObject("ADODB.Connection")
    Application.ScreenUpdating = False
For Each Rg In Sheet1.Range("G2:G" & Sheet1.UsedRange.Rows.Count)
           F = ThisWorkbook.Path & "\" & Rg.Value
    If Dir(F) > "" Then
             Cn.Open P & F & E
        With Cn.Execute("SELECT * FROM [Widget$C9:C9]")
             Rg(1, 2).Value = .GetRows
               .Close
        End With
             Cn.Close
    End If
Next
    Set Cn = Nothing
    Application.ScreenUpdating = True
End Sub

Do you like it ? So thanks to click on bottom right Like !
​