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.
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.
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
____________________________________________
Nihil simul inventum est et perfectum
Abusus non tollit usum
Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
James Thurber
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.