Updated to loop through all sheets with names starting with "Dept" and then add Summary sheet (note that you'll have to do some formatting of the summary sheet similar to what I did for the totals in the Dept sheets):

Code:
Sub addCols()
    Dim wb As Workbook      '*********************************************8
    Dim ws As Worksheet
    Dim h As Integer
    Dim j As Long
    Dim lr As Long
    
    Application.ScreenUpdating = False
    
    Set wb = ActiveWorkbook
    
    For h = 1 To wb.Worksheets.Count
        If Left(wb.Worksheets(h).Name, 3) = "Sum" Then
            Application.DisplayAlerts = False
            wb.Worksheets(h).Delete
            Exit Sub
        End If
    Next h
    
    For h = 1 To wb.Worksheets.Count

    If Left(wb.Worksheets(h).Name, 4) = "Dept" Then
        Set ws = wb.Worksheets(h)
        ws.Select
        lr = ws.Range("a4").End(xlDown).Row 'in your example, row 15
        
        With ws
            .Range("b1").Copy
            .Range("g1").PasteSpecial
            .Range("g2:j2").PasteSpecial
            .Application.CutCopyMode = False
            .Range("g1").Select
            
            .Range("g1").Value = "Forecast"
            .Range("g1:j1").MergeCells = True
            .Range("g1:j1").HorizontalAlignment = xlCenterAcrossSelection
            
            .Range("g2").Value = "Best"
            .Range("h2").Value = "Likely"
            .Range("i2").Value = "Worst"
            .Range("j2").Value = "Spread"
            
            .Range("b5:b" & lr).Copy
            .Range("g5").PasteSpecial xlPasteFormats
            .Range("h5").PasteSpecial xlPasteFormats
            .Range("i5").PasteSpecial xlPasteFormats
            .Range("j5").PasteSpecial xlPasteFormats
            
            .Range("g2:g" & lr).Interior.Color = 12379352
            .Range("h2:h" & lr).Interior.Color = 15986394
            .Range("i2:i" & lr).Interior.Color = 14281213
            .Range("j5").Formula = "=g5-i5"
            .Range("j5").Copy
            .Range("j6:j" & lr).PasteSpecial
            Application.CutCopyMode = False
            
            .Range("b" & lr + 2).FormulaR1C1 = "=SUM(R[" & 5 - (lr + 2) & "]C:R[-2]C)"
            .Range("b" & lr + 2).Copy
            .Range("c" & lr + 2 & ":e" & lr + 2).PasteSpecial
            .Range("g" & lr + 2 & ":j" & lr + 2).PasteSpecial
            Application.CutCopyMode = False
            .Range("a" & lr + 2).Value = "Total"    'changed this to "lr +2"
            
            .Range("k1").Value = "Comments"
            .Range("k1").Font.Bold = True
            .Range("k1").Font.Italic = True
            .Range("k1").ColumnWidth = 20
            .Range("k1").HorizontalAlignment = xlCenter
            .Range("k1:k2").Merge
            .Range("g5").Select
            
            
            .Range("g1:j1").BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
            .Range("g2:i2").BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
            .Range("j2").BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
            .Range("k1:k2").BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
            With .Range("g3:g" & lr).Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlColorIndexAutomatic
            End With
            With .Range("i3:i" & lr).Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlColorIndexAutomatic
            End With
            With .Range("j3:j" & lr).Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlColorIndexAutomatic
            End With
            With .Range("k3:k" & lr).Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlColorIndexAutomatic
            End With
        End With
        
        Set ws = Nothing
    End If
    Next h
    'create summary
    
    
    wb.Sheets.Add before:=wb.Worksheets(1)
    wb.Worksheets(1).Name = "Summary"
    Set ws = wb.Worksheets("Summary")
    
    With ws
        .Range("a3").Value = "Department"
        .Range("b3").Value = "Amount1"
        .Range("c3").Value = "Amount2"
        .Range("d3").Value = "Amount3"
        .Range("e3").Value = "Total"
        .Range("g3").Value = "Forecast"
        'best, likely, etc...
        
    For h = 2 To wb.Worksheets.Count
        If Left(wb.Worksheets(h).Name, 4) = "Dept" Then
            ws.Range("a" & 4 + h).Value = wb.Worksheets(h).Name
            lr = wb.Worksheets(h).Range("a" & Rows.Count).End(xlUp).Row
            For j = 2 To 5
                ws.Cells(4 + h, j) = wb.Worksheets(h).Cells(lr, j)
            Next j
            For j = 7 To 10
            
                'ws.Cells(4 + h, j) = wb.Worksheets(h).Cells(lr, j)
                'ActiveCell.FormulaR1C1 = "=Dept1!R[11]C"
                ws.Cells(4 + h, j).FormulaR1C1 = "=" & wb.Worksheets(h).Name & "!R[" _
                    & lr - (4 + h) & "]C"
                
            Next j
        End If
    Next h
    End With
    
    Set wb = Nothing
    Application.ScreenUpdating = True
End Sub