Create Multiple Excel Files from One file

[pivotguy]

I have one excel file and wanted to create multiple files out of this one file.
Any suggestions. The input file (input.xls) and the output file(craig.xls and Kelly.xls) is attached.

[Bob Phillips]

Public Sub SplitOut()
Dim this As Worksheet
Dim shTemp As Worksheet
Dim pvtTemp As PivotTable
Dim numrows As Long
Dim ws As Worksheet
Dim emp As String
Dim i As Long

    Application.ScreenUpdating = False

    With ThisWorkbook
    
        Set this = ActiveSheet
        Set shTemp = .Worksheets.Add(after:=.Worksheets(.Worksheets.Count))
        .PivotCaches.Create(SourceType:=xlDatabase, _
                            SourceData:="order!R1C1:R9C5", _
                            Version:=xlPivotTableVersion12).CreatePivotTable _
                                    TableDestination:=shTemp.Name & "!R1C1", _
                                    TableName:="pvtTemp", _
                                    DefaultVersion:=xlPivotTableVersion12
        
        Set pvtTemp = ActiveSheet.PivotTables("pvtTemp")
        With pvtTemp
        
            With .PivotFields("AM Name")
                .Orientation = xlPageField
                .Position = 1
            End With
            With .PivotFields("Order " & Chr(10) & "Date")
                .Orientation = xlRowField
                .Position = 1
                .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            End With
            With .PivotFields("Order Status")
                .Orientation = xlRowField
                .Position = 2
                .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            End With
            With .PivotFields("Source")
                .Orientation = xlRowField
                .Position = 3
                .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            End With
            With .PivotFields("Employee Id")
                .Orientation = xlRowField
                .Position = 4
                .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
            End With
    
            .DisplayFieldCaptions = False
            .ShowDrillIndicators = False
            .RepeatAllLabels xlRepeatLabels
            .ColumnGrand = False
            .RowGrand = False
            .InGridDropZones = True
            .RowAxisLayout xlTabularRow
   
            .ShowPages PageField:="AM Name"
        End With
        
        For i = .Worksheets.Count To 1 Step -1
        
            Set ws = .Worksheets(i)
            If Not ws Is this And Not ws Is shTemp Then
            
                With ws
                
                    .Activate
                    emp = .Name
                    .PivotTables(1).PivotSelect "", xlDataAndLabel, True
                    Selection.Copy
                    Selection.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
                    .Rows("2:4").Delete Shift:=xlUp
                    .Columns("D").Insert
                    .Range("A1:E1").Value = Array("Order Date", "Order Status", "Source", "AM Name", "Employee Id")
                    numrows = Application.CountIf(this.Columns("D"), emp)
                    .Range("D2").Resize(numrows).Value = emp
                    .Columns("A:E").AutoFit
                    .Move
                    
                    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & emp & " " & Application.VLookup(emp, this.Columns("D:E"), 2, False)
                    ActiveWorkbook.Close SaveChanges:=False
                End With
            End If
        Next i
        
        Application.DisplayAlerts = False
        shTemp.Delete
    End With

    Application.ScreenUpdating = True
End Sub

[pivotguy]

XLD,

It cut and paste the data from input file to output file and created files for each employee. However, it did not create "SUMMARY" Tab. Any suggestion.

[snb]

http://www.excelguru.ca/forums/showt...-from-One-file