Macro to loop through Excel files and extract cell contents?

[TheWennerWoman]

Hello,

I have a folder structure where the top level is 2020 and then within that folder there are 12 folders, one for each of the months. Within each of the months, there are five folders, W1, W2, W3, W4 and M.

It is the M folder I am interested in.

Is there a way to have a macro run and do the following:

• open each spreadsheet it finds (these will be .xls extensions, not .xlsx)
• extract the contents of cell A12 from a tab named "submit"
• record those contents along with the filename of the spreadsheet concerned

All of the spreadsheets are the same format so I just need something to systematically loop through each one.

Any advice greatly appreciated as always.

 

[XLfriend777]

Hello WennerWoman. I put the following code together as a combination of things I found on the web. TRY THIS ON A SAMPLE DATA SET! All macros are not reversible so do not use this on anything but practice data. The only thing it SHOULD do is color Cell A12 in the "submit" tab Yellow RGB(255,255,0). This may help get you started. What you want to do is certainly possible, but it is not straight forward. Again - do not run this on your real files. Macros are not reversible. Create a sample file structure as I did to test before running on your actual data. Hope this helps get you started.

Sub LoopThroughFiles()

Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim i As Integer

Set oFSO = CreateObject("Scripting.FileSystemObject")

'Set oFolder = oFSO.GetFolder("C:\Users\xxxx\Desktop\MrExcel\2020\01")
'Put your folder location here.
Set oFolder = oFSO.GetFolder("... Your location here ... \Desktop\MrExcel\2020\01")

For Each oFile In oFolder.Files
' Cells(i + 1, 1) = oFile.Name
' i = i + 1
myPath = oFolder
myFile = oFile.Name
'*******************************
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & "\" & myFile)

'Ensure Workbook has opened before moving on to next line of code
DoEvents

'Change First Worksheet's submit A12 to Yellow RGB(255,255,0)
wb.Worksheets("submit").Range("A12").Interior.Color = RGB(255, 255, 0)

'Save and Close Workbook
wb.Close SaveChanges:=True

'Ensure Workbook has closed before moving on to next line of code
      DoEvents

'*******************************
Next oFile

End Sub

 

[TheWennerWoman]

Very good, thank you for that. I have amended it to capture the cell contents and it all works perfectly.

 

[XLfriend777]

Fantastic. Thanks for the feedback. Happy Excelling!

 

[rjmdc]

hi
how would i adapt this code to loop through about 100 single page workbooks
capture row $B$2:$K$2
copy the entire line of each workbook and paste onto another sheet creating a list of all line 2's

 

[rjmdc]

sorry