Compile a list/ summary of a specific cell from multiple workbooks with VBA? - vba

Question

I have multiple workbooks in the same layout. In the cell "I8" I have calculated a specific value that I want to compile from all workbooks.
Here is an example of my code:
Sub Code()
Dim file As String
Dim wbResults As Workbook
Dim myPath As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
myPath = "C:\Test\"
file = Dir$(myPath & "*.xls*")
While (Len(file) > 0)
Set wbResults = Workbooks.Open(Filename:=myPath & file, UpdateLinks:=0)
With wbResults.Worksheets(Split(file, ".")(0))
With .Range("I8")
.Formula = "=10^(D28+(I7*I2))"
End With
End With
wbResults.Close SaveChanges:=True
file = Dir
Wend
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I would like to add to this code and compile a list in another excel workbook where column A puts the name of the file of a workbook and column B puts the value of "I8" in that respective workbook.

Answer 1

Here is my answer:
Sub Code()
Dim file As String
Dim wbResults As Workbook
Dim myPath As String
myPath = "C:\Test\"
'---------------- Create a new workbook then save it ----------------
Dim WBSummary As Workbook
Set WBSummary = Excel.Application.Workbooks.Add
WBSummary.SaveAs myPath & "WBSummary.xls"
'--------------------------------------------------------------------
Application.ScreenUpdating = False
Application.DisplayAlerts = False
file = Dir$(myPath & "*.xls*")
Dim i As Long 'To update row number in WBSummary
While (Len(file) > 0)
i = i + 1
If file <> "WBSummary.xls" Then
Set wbResults = Workbooks.Open(Filename:=myPath & file, UpdateLinks:=0)
With wbResults.Worksheets(Split(file, ".")(0))
With .Range("I8")
.Formula = "=10^(D28+(I7*I2))"
.Calculate 'To update value in "I8"
WBSummary.Worksheets(1).Cells(i, 1).Value = file
WBSummary.Worksheets(1).Cells(i, 2).Value = .Value
End With
End With
wbResults.Close SaveChanges:=True
End If
file = Dir
Wend
WBSummary.Close True 'Close and Save WBSummary
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub