Vba importing worksheets and summarising totals

[Matt_001]

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

 

[JLGWhiz]

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
        Sheets(i).Delete
        Application.DisplayAlerts = True
    Next
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
        Loop
    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
                    Else
                        sh.Cells(Rows.Count, 1).End(xlUp)(3) = Sheets(j).Name
                    End If
                    adr = fn.Address
                    Do
                        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
        Next
        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