pivotguy
01-05-2016, 03:17 AM
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
01-05-2016, 06:40 AM
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
01-05-2016, 03:47 PM
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.
http://www.excelguru.ca/forums/showthread.php?5317-Create-Multiple-Excel-Files-from-One-file
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.