How to Save in 2003 Format

balvinder

Registered User.
Local time
Today, 07:48
Joined
Jun 26, 2011
Messages
47
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.

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
 

Users who are viewing this thread

Back
Top Bottom