PDA

View Full Version : Create Multiple Excel Files from One file



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.

xld
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.

snb
01-06-2016, 12:34 PM
http://www.excelguru.ca/forums/showthread.php?5317-Create-Multiple-Excel-Files-from-One-file