Option Explicit
Option Base 1
Sub GetClosedSums()
Application.ScreenUpdating = False
Dim RangeSum As Long, _
FolderList As Range, _
SystemList As Range, _
SumRange As String, _
FileRoot As String, _
FName As String, _
SumAddress As String, _
FolderName As Variant, _
SubSystem As Variant, _
SUMMARYSHEET
FileRoot = "C:\Directory\"
Set SUMMARYSHEET = Workbooks("30 day SUMMARY.xls").Sheets("sheet1")
Set FolderList = Sheets("sheet1").Range("B7:AG7")
For Each FolderName In FolderList
If Len(Dir$(FileRoot & FolderName, vbDirectory)) <> 0 Then
FName = FolderName.Offset(1, 0).Value
If Len(Dir$(FileRoot & FolderName & "\" & FName & ".xls", vbNormal)) <> 0 Then
Workbooks.Open FileName:=FileRoot & FolderName & "\" & FName & ".xls"
Set SystemList = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
For Each SubSystem In SystemList
SumAddress = "B" & SubSystem.Row & ":AW" & SubSystem.Row
RangeSum = WorksheetFunction.Sum(ActiveSheet.Range(SumAddress))
SUMMARYSHEET.Cells(SubSystem.Row + 10, FolderName.Column) = RangeSum
Next SubSystem
Workbooks(FName & ".xls").Close False
End If
End If
Next FolderName
Application.ScreenUpdating = False
End Sub
Note that the subfolders must be in "C:\DIRECTORY"
Bookmarks