Macro to loop through Excel files and extract cell contents?

TheWennerWoman

New Member
Joined
Aug 1, 2019
Messages
48
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.
 

Some videos you may like

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

goesr

Well-known Member
Joined
Nov 15, 2013
Messages
637
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.

VBA Code:
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
 
Solution

TheWennerWoman

New Member
Joined
Aug 1, 2019
Messages
48
Very good, thank you for that. I have amended it to capture the cell contents and it all works perfectly.
 

rjmdc

Active Member
Joined
Apr 29, 2020
Messages
364
Office Version
  1. 365
Platform
  1. Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,119,022
Messages
5,575,622
Members
412,679
Latest member
TSpan
Top