Evening,

I have the following code which opens a file within a subfolder of the activeworkbookpath, using the filename stored in cell B70. However, the file could be stored within 1 subfolder, or within multiple subfolders, so I need the code to look through all subfolders of the activeworkbookpath.

Also, ideally, it would be great if a loop could be in place that would open the filename at B70, extract the relevant information and paste to A1, then open the filename at B71 and extract relevant information and paste to A2 and repeat until cell B# is blank.

Is this possible?? Thanks in advance!!

Sub Data ()
Dim simWbk As Excel.Workbook
Dim simSht As Worksheet

Set simWbk = ActiveWorkbook
Set simSht = ActiveSheet



Dim strFilePath As String
Dim strFileName As String
Dim objFolder As Object

strFilePath = ActiveWorkbook.Path & "\"
strFileName = strFilePath & Sheets("Temp_Data").Range("B70")

For Each objFolder In CreateObject("Scripting.FileSystemObject"). _
        GetFolder(strFilePath).SubFolders
  If Len(Dir(objFolder.Path & "\" & Sheets("Temp_Data").Range("B70"))) > 0 Then
    With Workbooks.Open(objFolder.Path & "\" & Sheets("Temp_Data").Range("B70"))
      .Sheets(1).Range("A1:W1").Copy
      ThisWorkbook.Sheets("Temp_Data").Range("A1").PasteSpecial xlPasteValues
      Application.DisplayAlerts = False
      .Close False
    End With
    Sheets("Temp_Data").Range("A63").Value = Mid$(strFileName, InStrRev(strFileName, "\") + 1)
  End If
Next objFolder
Application.ScreenUpdating = True
End sub