Extracting same cell range + file name from multiple books

[Benjaminmin]

Hi all,

I am writing to ask for help with a macro to help me perform 2 principal tasks across 60 files I have in a folder:

• Extract cells B6:B8 from each of the 60 files
• Extract the first part of the file name [the date] - each file is named "DD MM YY Report" (e.g. "01 06 2017 report") and I want to extract the "DD MM YY part"

Ideally the macro would pull this data and collate it into a single sheet in the following format:

• For the first book it reads:
• The file name extract/ date in e.g. B1
• The extracted vales into B2:B4
• Then offset by one column for the next one, i.e. paste date into C1 and values into C2:C4
• Repeat for all 60 files in the folder

Does anyone know if this is possible please?

Many thanks in advance for all your help!

Cheers,
Ben

 

[Eric W]

Try this:

1) Open a new workbook
2) Press Alt-F11 to open the VBA editor
3) From the menu, click Insert > Module
4) Paste the following code in the window that opens

Public Sub GetData()
Dim MyPath As String
Dim MyRow As Long, MyPasth As String, MyCol As Long
Dim fso As Object, fldStart As Object, fl As Object
Dim ts As Worksheet

' Initialization
    MyPath = "c:\Users\username\Desktop\MyFolder2"
     
    MyCol = 1
    Set fso = CreateObject("scripting.FileSystemObject")
    Set fldStart = fso.GetFolder(MyPath)
    Cells.ClearContents

    Set ts = ThisWorkbook.Sheets("Sheet1")
    
    Application.ScreenUpdating = False
    
' 1st section
' Find all the matching files in this directory.  Open the file, get the data

    For Each fl In fldStart.Files
        If fl.Name Like "*.xl*" Then
            Workbooks.Open Filename:=MyPath & "\" & fl.Name
            MyCol = MyCol + 1
            ts.Cells(1, MyCol) = Left(fl.Name, 8)
            ts.Cells(2, MyCol).Resize(3, 1).Value = ActiveSheet.Range("B6:B8").Value
            ActiveWorkbook.Close savechanges:=False
        End If
    Next fl
    
' finalization
    Application.ScreenUpdating = True
    Set fso = Nothing
    Set fldStart = Nothing

End Sub

5) Change the path name to your folder
6) Close the editor (Alt-Q, or use the red X)
7) Press Alt-F8, select GetData, and click Run

Let us know how that works.

 

[Benjaminmin]

Hi Eric,

That is absolutely amazing - works perfectly, exactly what I wanted it to do!!

Thank you very much - I really appreciate the quick and perfect help!!

Best,
Ben

 

[Eric W]

Happy to help!