What I have: A VBA routine I found somewhere and tried to adapt to my problem. I understand that this routine looks for all excel Workbooks in a folder and merges all files range H8:H27 in a new Workbook.
What I need: A routine that looks for all Excel workbooks (excluding totals.xlsx) in a folder, and sums the values in range Sheet(2)H8:H27 to the workbook totals.xlsx! sheet(2)H8:H27
I have a folder containing 67 Excel Workbooks including one Workbook called totals.xlsx;
Excluding totals.xls, the other Workbooks have huge names. Sheet number 2 in all books also have a huge name.
All the books have the same structure;
I need to sum all Workbook´s (excluding totals.xlsx) values in range sheet(2)H8:H27 to the same range in workbook total.xls! sheet (2)H8:H27;
I cannot use Consolidate tool as the limit is 50 files;
It is almost impossible to write a formula which refers to 67 workbooks having huge names, with sheet (2) also having a huge name;
So I did think about VBA routine to SUM values in range H8:H27 of all Workbooks (excluding totals.xlsx) in a folder to the same range in sheet (2) of totals.xlsx Workbook
I found and adapted the following VBA Routine. I think I am almost there, but so far I have been able to merge the values to a separated Workbook. Have no idea how to sum All Workbooks (excluding totals.xlsx)! sheet (2)H8:H27 to totals.xlsx! sheet(2)H8:H27
Sub MergeAllWorkbooks() Dim MyPath As String, FilesInPath As String Dim MyFiles() As String Dim SourceRcount As Long, FNum As Long Dim mybook As Workbook, BaseWks As Worksheet Dim sourceRange As Range, destrange As Range Dim rnum As Long, CalcMode As Long MyPath = "C:\Users\test" If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\" End If FilesInPath = Dir(MyPath & "*.xl*") If FilesInPath = "" Then MsgBox "No files found" Exit Sub End If FNum = 0 Do While FilesInPath <> "" FNum = FNum + 1 ReDim Preserve MyFiles(1 To FNum) MyFiles(FNum) = FilesInPath FilesInPath = Dir() Loop With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False .EnableEvents = False End With Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1) rnum = 1 If FNum > 0 Then For FNum = LBound(MyFiles) To UBound(MyFiles) Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(MyPath & MyFiles(FNum)) On Error GoTo 0 If Not mybook Is Nothing Then On Error Resume Next With mybook.Worksheets(1) Set sourceRange = .Range("A1:C1") End With If Err.Number > 0 Then Err.Clear Set sourceRange = Nothing Else If sourceRange.Columns.Count >= BaseWks.Columns.Count Then Set sourceRange = Nothing End If End If On Error GoTo 0 If Not sourceRange Is Nothing Then SourceRcount = sourceRange.Rows.Count If rnum + SourceRcount >= BaseWks.Rows.Count Then MsgBox "There are not enough rows in the target worksheet." BaseWks.Columns.AutoFit mybook.Close savechanges:=False GoTo ExitTheSub Else With sourceRange BaseWks.Cells(rnum, "A"). _ Resize(.Rows.Count).Value = MyFiles(FNum) End With Set destrange = BaseWks.Range("B" & rnum) With sourceRange Set destrange = destrange. _ Resize(.Rows.Count, .Columns.Count) End With destrange.Value = sourceRange.Value rnum = rnum + SourceRcount End If End If mybook.Close savechanges:=False End If Next FNum BaseWks.Columns.AutoFit End If ExitTheSub: With Application .ScreenUpdating = True .EnableEvents = True .Calculation = CalcMode End With End Sub