Trying to rework the way my workbook works

Right now my w开发者_如何学Goorkbook has one master sheet and 30-something individual sheets. All the individuals are formatted exactly the same and just pull information for different departments within the company. Is there a way, incorporating the macros I use to pull each department's information, to get rid of all the individual sheets for one template worksheet? I'd like to change it so that when I run the macro for a specific department excel opens a new worksheet based off the template and then puts the information that my current macro pulls into the new worksheet. What I use now to pull from the master worksheet follows:

Sub DepartmentName()

    Dim LCopyToRow As Long
    Dim LCopyToCol As Long
    Dim arrColsToCopy
    Dim c As Range, x As Integer

    On Error GoTo Err_Execute


    arrColsToCopy = Array(1, 3, 4, 8, 25, 16, 17, 15) 'which columns to copy ?
    Set c = Sheets("MasterSheet").Range("Y5")  'Start search in Row 5
    LCopyToRow = 10 'Start copying data to row 10 in DepartmentSheet

    While Len(c.Value) > 0

        'If value in column Y ends with "2540", copy to DepartmentSheet        
        If c.Value Like "*2540" Then

            LCopyToCol = 1

            Sheets("DepartmentSheet").Cells(LCopyToRow, LCopyToCol).EntireRow.Insert shift:=x1Down

            For x = LBound(arrColsToCopy) To UBound(arrColsToCopy)

                Sheets("DepartmentSheet").Cells(LCopyToRow, LCopyToCol).Value = _
                               c.EntireRow.Cells(arrColsToCopy(x)).Value

                 LCopyToCol = LCopyToCol + 1

            Next x

            LCopyToRow = LCopyToRow + 1 'next row

        End If

        Set c = c.Offset(1, 0)

    Wend

    'Position on cell A5
    Range("A5").Select

    MsgBox "All matching data has been copied."

    Exit Sub

Err_Execute:
        MsgBox "An error occurred."

End Sub

I would like to insert something into this so that it opens a template and then posts the information exactly the way it does above.

This code should do what you need:

Sub Test()
    CreateDepartmentReport ("2540")
End Sub
Sub CreateDepartmentReport(strDepartment)

    Sheets("DepartmentSheet").UsedRange.Offset(10).ClearContents

    With Sheets("MasterSheet").Range("C4", Sheets("MasterSheet").Cells(Rows.Count, "C").End(xlUp))
        .AutoFilter Field:=1, Criteria1:="=*" & strDepartment, Operator:=xlAnd
        .SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("DepartmentSheet").[A10]
    End With

    With Sheets("MasterSheet")
        If .AutoFilterMode Then .AutoFilterMode = False
    End With

    Sheets("DepartmentSheet").Range("B:B,E:G,I:X").EntireColumn.Hidden = True

    MsgBox "All matching data has been copied.", vbInformation, "Alert!"

End Sub

Notes: Instead of coping your template sheet to get a new presentation sheet, just setup your template sheet as you want it and the code above will clear the data on it before copying the new data to it. And instead of only trying to copy specific columns, the code will hide the columns you don't want on your presentation sheet.

EDIT2: Option to remove all other dept sheets

Sub Tester()
    CreateDeptReport "2540"       'just recreates the dept sheet
   'CreateDeptReport "2540", True 'also removes all other depts
End Sub


Sub CreateDeptReport(DeptName As String, Optional ClearAllSheets As Boolean = False)

    Const TEMPLATE_SHEET As String = "Report template" 'your dept template
    Const MASTER_SHEET As String = "MasterSheet"

    Dim shtRpt As Excel.Worksheet, shtMaster As Excel.Worksheet
    Dim LCopyToRow As Long
    Dim LCopyToCol As Long
    Dim arrColsToCopy
    Dim c As Range, x As Integer
    Dim sht As Excel.Worksheet

    On Error GoTo Err_Execute

    arrColsToCopy = Array(1, 3, 4, 8, 25, 16, 17, 15) 'which columns to copy ?

    Set shtMaster = ThisWorkbook.Sheets(MASTER_SHEET)
    Set c = shtMaster.Range("Y5")  'Start search in Row 5

    LCopyToRow = 10 'Start copying data to row 10 in DepartmentSheet

    While Len(c.Value) > 0
        'If value in column Y ends with dept name, copy to report sheet
        If c.Value Like "*" & DeptName Then

            'only create the new sheet if any records are found
            If shtRpt Is Nothing Then
                For Each sht In ThisWorkbook.Sheets
                    If sht.Name <> MASTER_SHEET And sht.Name <> _
                                                    TEMPLATE_SHEET Then
                        If ClearAllSheets Or sht.Name = DeptName Then
                            Application.DisplayAlerts = False
                            sht.Delete
                            Application.DisplayAlerts = True
                        End If
                    End If
                Next sht

                ThisWorkbook.Sheets(TEMPLATE_SHEET).Copy after:=shtMaster
                Set shtRpt = ThisWorkbook.Sheets(shtMaster.Index + 1)
                shtRpt.Name = DeptName 'rename new sheet to Dept name
            End If

            LCopyToCol = 1
            shtRpt.Cells(LCopyToRow, LCopyToCol).EntireRow.Insert shift:=xlDown

            For x = LBound(arrColsToCopy) To UBound(arrColsToCopy)

                shtRpt.Cells(LCopyToRow, LCopyToCol).Value = _
                             c.EntireRow.Cells(arrColsToCopy(x)).Value

                 LCopyToCol = LCopyToCol + 1

            Next x

            LCopyToRow = LCopyToRow + 1 'next row
        End If
        Set c = c.Offset(1, 0)
    Wend

    Range("A5").Select 'Position on cell A5
    MsgBox "All matching data has been copied."
    Exit Sub

Err_Execute:
        MsgBox "An error occurred."
End Sub