Hi,
I'am using Excel 2007. I have created one macro to extract data on the basis of one field inclusive of Pivotsummary. I want to save Output excel file in .xls format instead of .xlsx
Need support to check where I'am lacking.
Using below code I'am able to extract data with pivot summary & file is getting saved in (D:\Agent Data Sheets) folder.
I'am using Excel 2007. I have created one macro to extract data on the basis of one field inclusive of Pivotsummary. I want to save Output excel file in .xls format instead of .xlsx
Need support to check where I'am lacking.
Using below code I'am able to extract data with pivot summary & file is getting saved in (D:\Agent Data Sheets) folder.
Code:
Sub details()
Dim thisWB As String
Dim newWB As String
thisWB = ActiveWorkbook.Name
On Error Resume Next
Sheets("tempsheet").Delete
On Error GoTo 0
Sheets.Add
ActiveSheet.Name = "tempsheet"
Sheets("Total Data").Select
If ActiveSheet.AutoFilterMode Then
Cells.Select
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
End If
Columns("R:R").Select
Selection.Copy
Sheets("tempsheet").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
If (Cells(1, 1) = "") Then
lastrow = Cells(1, 1).End(xlDown).Row
If lastrow <> Rows.Count Then
Range("A1:A" & lastrow - 1).Select
Selection.Delete Shift:=xlUp
End If
End If
Columns("A:A").Select
Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B1"), Unique:=True
Columns("A:A").Delete
Cells.Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
lMaxSupp = Cells(Rows.Count, 1).End(xlUp).Row
For suppno = 2 To lMaxSupp
Windows(thisWB).Activate
supName = Sheets("tempsheet").Range("A" & suppno)
If supName <> "" Then
Workbooks.Add
ActiveWorkbook.SaveAs supName
newWB = ActiveWorkbook.Name
Windows(thisWB).Activate
Sheets("Total Data").Select
Cells.Select
If ActiveSheet.AutoFilterMode = False Then
Selection.AutoFilter
End If
Selection.AutoFilter Field:=18, Criteria1:="=" & supName, Operator:=xlAnd, Criteria2:="<>"
lastrow = Cells(Rows.Count, 2).End(xlUp).Row
Rows("1:" & lastrow).Copy
Windows(newWB).Activate
ActiveSheet.Paste
Selection.AutoFilter
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Sheet1!A1:AM65000", Version:=xlPivotTableVersion11).CreatePivotTable TableDestination:="", TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion11
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("STATUS")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("PLAN_ID")
.Orientation = xlRowField
.Position = 2
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables("PivotTable1").PivotFields("PLAN_ID"), "Count of PLAN_ID", xlCount
ActiveSheet.PivotTables("PivotTable1").PivotFields("Count of PLAN_ID").Caption = "Count"
ActiveSheet.PivotTables("PivotTable1").PivotFields("STATUS").AutoSort xlDescending, "Count"
ActiveSheet.PivotTables("PivotTable1").CompactLayoutRowHeader = "Policy Status"
With ActiveSheet.PivotTables("PivotTable1").PivotFields("STATUS")
.PivotItems("(blank)").Visible = False
End With
Range("A4").Select
ActiveSheet.PivotTables("PivotTable1").TableStyle2 = "PivotStyleMedium3"
Range("A3:B3").Select
Range(Selection, Selection.End(xlDown)).Select
Range("A1").Select
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Total Data"
Sheets("Sheet2").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Sheet3").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Sheet4").Select
Sheets("Sheet4").Name = "Summary of Policies"
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
Next
Sheets("tempsheet").Delete
Sheets("Total Data").Select
If ActiveSheet.AutoFilterMode Then
Cells.Select
ActiveSheet.ShowAllData
End If
End Sub