Vba importing worksheets and summarising totals


New Member
Dec 17, 2016
Hi everyone.... I have just joined the forum as i desparately start my quest to understand microsoft vba! I am posting a 'live' problem i have as this seems to be the best way to learn. In summary, i have 10 separate workbooks, all housed in one folder. The format of each workbook is different, however, each workbook will have the name 'total' appear at least once in different columns. I would like to create a macro which imports all of the workbooks in the folder into one spreadsheet housing each workbook in a separate tab and naming the tab the name of the relevant workbook. I would then like a separate tab to be created called 'summary' which summarises the name of each of the workbooks in one column with the total of the totals from each workbook in the next column along so i can check it all reconciles. Any help/direction would be greatly appreciated. Thanks. Matt

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.


Well-known Member
Feb 7, 2012
Office Version
  1. 2013
  1. Windows
Welcome to the forum Matt_001. Here is the code.

Sub totals()
Dim sh As Worksheet, wb As Workbook, fPath As String, fName As String, fn As Range, adr As String
If ThisWorkbook.Sheets.Count > 1 Then
    For i = ThisWorkbook.Sheets.Count To 2 Step -1 'Remove all sheets but sheet 1 from summary workbook.
        Application.DisplayAlerts = False
        Application.DisplayAlerts = True
End If
Set sh = ThisWorkbook.Sheets("Sheet1")
fPath = ThisWorkbook.Path 'If ThisWorkbook in different directory, then substitute directory path here
If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
fName = Dir(fPath & "*.xl*")
        Do While fName <> ""
            If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName)
            wb.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Left(wb.Name, InStr(wb.Name, ".") - 1)
            wb.Close False
            End If
            fName = Dir
    If ThisWorkbook.Sheets.Count > 1 Then
        For j = 2 To ThisWorkbook.Sheets.Count
            Set fn = Sheets(j).UsedRange.Find("Total", , xlValues, xlWhole)
                If Not fn Is Nothing Then
                    If sh.Range("A2") = "" Then
                        sh.Range("A2") = Sheets(j).Name
                        sh.Cells(Rows.Count, 1).End(xlUp)(3) = Sheets(j).Name
                    End If
                    adr = fn.Address
                        sh.Cells(Rows.Count, 1).End(xlUp)(2) = fn.Offset(, 1).Value
                        Set fn = Sheets(j).UsedRange.FindNext(fn)
                    Loop While adr <> fn.Address
                    sh.Cells(Rows.Count, 1).End(xlUp).Offset(, 1) = _
                    Application.Sum(sh.Cells(Rows.Count, 1).End(xlUp).CurrentRegion)
                End If
        sh.Range("C2") = "Grand Total"
        sh.Range("D2") = Application.Sum(sh.Range("B2", sh.Cells(Rows.Count, 2).End(xlUp)))
    End If
End Sub

Here are the assumption on which the code is based. If these assumptions are false, the code fails and you will need to modify it to use it.
Assume the workbook which hosts the code is in the same directory (Folder) as the 10 workbooks, otherwise the path must be spelled out. Also assume that each of the 10 workbooks is either a single sheet workbook or that only sheet 1 is used for the data. Assume that the value for the Total is in the immediate right cell.

Regards, JLG
Upvote 0

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back