Sub CreatePivot()
    Dim WSD As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long
    Set WSD = Worksheets("TabelaPrzestawna")

    ' Usu wszystkie wczeniejsze tabele przestawne
    For Each PT In WSD.PivotTables
        PT.TableRange2.Clear
    Next PT
    WSD.Range("M1:Z1").EntireColumn.Clear


    ' Zdefiniuj obszar danych wejciowych i skonfiguruj pami podrczn tabeli przestawnej
    FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = WSD.Cells(1, Application.Columns.Count). _
        End(xlToLeft).Column
    Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
        xlDatabase, SourceData:=PRange.Address)

    ' Utwrz tabel przestawn z pamici podrcznej
    Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
        Cells(2, FinalCol + 2), TableName:="TabelaPrzestawna1")

    ' Wycz rczn aktualizacj w czasie budowania tabeli
    PT.ManualUpdate = True

    ' Okrel pola wierszy i kolumn
    PT.AddFields RowFields:=Array("Linia biznesowa", "Model"), _
        ColumnFields:="Region"

    ' Ustaw pola danych
    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
    End With

    ' Przelicz tabel przestawn
    PT.ManualUpdate = False
    PT.ManualUpdate = True

    ' Formatuj tabel przestawn
    PT.ShowTableStyleRowStripes = True
    PT.TableStyle2 = "PivotStyleMedium10"
    
    WSD.Activate
    Range("M1").Select

End Sub

Sub DeleteR()

    Dim WSD As Worksheet
    Set WSD = Worksheets("TabelaPrzestawna")
    WSD.Activate
    Range("R1").EntireColumn.Delete
End Sub


Sub CreateSummaryReportUsingPivot()
    ' Uyj tabeli przestawnej do utworzenia statycznego raportu z podsumowaniem
    ' z modelami w kolumnach i regionami w wierszach
    Dim WSD As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long
    Set WSD = Worksheets("TabelaPrzestawna")

    ' Usu wszystkie wczeniejsze tabele przestawne
    For Each PT In WSD.PivotTables
        PT.TableRange2.Clear
    Next PT
    WSD.Range("M1:Z1").EntireColumn.Clear

    ' Zdefiniuj obszar danych wejciowych i skonfiguruj pami podrczn tabeli przestawnej
    FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = WSD.Cells(1, Application.Columns.Count). _
        End(xlToLeft).Column
    Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
        xlDatabase, SourceData:=PRange.Address)

    ' Utwrz tabel przestawn z pamici podrcznej
    Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
        Cells(2, FinalCol + 2), TableName:="TabelaPrzestawna1")

    ' Wycz aktualizacj na czas budowania tabeli
    PT.ManualUpdate = True

    ' Skonfiguruj pola wierszy
    PT.AddFields RowFields:="Model", ColumnFields:="Region"

    ' Skonfiguruj pola danych
    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
    End With

    With PT
        .ColumnGrand = False
        .RowGrand = False
        .NullString = "0"
    End With

    ' Przelicz tabel przestawn
    PT.ManualUpdate = False
    PT.ManualUpdate = True

    ' PT.TableRange2 zawiera wyni. Przenie go do J10
    ' jako wartoci, a nie dynamiczn tabel przestawn.
    PT.TableRange2.Offset(1, 0).Copy
    WSD.Cells(5 + PT.TableRange2.Rows.Count, FinalCol + 2). _
        PasteSpecial xlPasteValues

    ' W tum miejscu arkusz wyglda jak na rysunku 12.5

    ' Usu oryginaln tabel przestawn i pami podrczn
    PT.TableRange2.Clear
    Set PTCache = Nothing

    WSD.Activate
    Range("M1").Select
End Sub



Sub ProductLineReport()
    ' Linia biznesowa oraz rynek jako wiersze
    ' Lata jako kolumny
    Dim WSD As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long
    Dim TotColumns()

    Set WSD = Worksheets("TabelaPrzestawna")
    Dim WSR As Worksheet
    Dim WBO As Workbook
    Dim WBN As Workbook
    Set WBO = ActiveWorkbook

    ' Usu wszystkie wczeniejsze tabele przestawne
    For Each PT In WSD.PivotTables
        PT.TableRange2.Clear
    Next PT
    WSD.Range("M1:Z1").EntireColumn.Clear

    ' Zdefiniuj obszar danych wejciowych i skonfiguruj pami podrczn tabeli przestawnej
    FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = WSD.Cells(1, Application.Columns.Count). _
        End(xlToLeft).Column
    Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
        xlDatabase, SourceData:=PRange.Address)

    ' Utwrz tabel przestawn z pamici podrcznej tabeli przestawnej
    Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
        Cells(2, FinalCol + 2), TableName:="TabelaPrzestawna1")

    ' Wycz aktualizacj na czas budowania tabeli
    PT.ManualUpdate = True

    ' Skonfiguruj pola wierszy
    PT.AddFields RowFields:=Array("Linia biznesowa", _
        "Data bilansu"), ColumnFields:="Rynek"

    ' Skonfiguruj pola danych
    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
    End With

    ' Przelicz tabel przestawn
    PT.ManualUpdate = False
    PT.ManualUpdate = True

    ' Grupuj wedug lat
    WSD.Activate
    Cells(3, FinalCol + 3).Group Start:=True, End:=True, _
        Periods:=Array(False, False, False, False, False, False, True)

    ' Przenie dat bilansu do kolumn
    PT.PivotFields("Data bilansu").Orientation = xlColumnField
    PT.PivotFields("Rynek").Orientation = xlRowField

    PT.PivotFields("Suma z Dochd").NumberFormat = "#,##0,K"
    PT.PivotFields("Linia biznesowa").Subtotals(1) = True
    PT.PivotFields("Linia biznesowa").Subtotals(1) = False
    PT.ColumnGrand = False

    ' Przelicz tabel przestawn
    PT.ManualUpdate = False
    PT.ManualUpdate = True

    ' PT.TableRange2.Select

    ' Utwrz nowy pusty skoroszyt z jednym arkuszem
    Set WBN = Workbooks.Add(xlWBATWorksheet)
    Set WSR = WBN.Worksheets(1)
    WSR.Name = "Raport"
    ' Skonfiguruj tytu raportu
    With WSR.[A1]
        .Value = "Dochody wedug rynku i roku"
        .Font.Size = 14
    End With

    ' Skopiuj dane tabeli przestawnej do 3 wiersza arkusza Raport
    ' Uyj waciwoci Offset, aby wyeliminowa wiersz tytuu tabeli przestawnej
    PT.TableRange2.Offset(1, 0).Copy
    WSR.[A3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    PT.TableRange2.Clear
    Set PTCache = Nothing

    ' Wypenij widok konspektu w kolumnie A
    ' Poszukaj ostatniego wiersza w kolumnie B, poniewa wiele wierszy
    ' w kolumnie A jest pustych
    FinalReportRow = WSR.Range("B65536").End(xlUp).Row
    With Range("A3").Resize(FinalReportRow - 2, 1)
        With .SpecialCells(xlCellTypeBlanks)
            .FormulaR1C1 = "=R[-1]C"
        End With
        .Value = .Value
    End With

    ' Podstawowe formatowanie.
    ' Ustaw autodopasowanie kolumn, pogrub nagwki i wyrwnaj je do prawej
    Selection.Columns.AutoFit
    Range("A3").EntireRow.Font.Bold = True
    Range("A3").EntireRow.HorizontalAlignment = xlRight
    Range("A3:B3").HorizontalAlignment = xlLeft

    ' Powtarzaj wiersze 1-3 na grze kadej strony
    WSR.PageSetup.PrintTitleRows = "$1:$3"

    ' Dodaj sumy czciowe
    FinalCol = Cells(3, 255).End(xlToLeft).Column
    ReDim Preserve TotColumns(1 To FinalCol - 2)
    For i = 3 To FinalCol
        TotColumns(i - 2) = i
    Next i
    Selection.Subtotal GroupBy:=1, Function:=xlSum, _
        TotalList:=TotColumns, Replace:=True, _
        PageBreaks:=True, SummaryBelowData:=True

    ' Upewnij si, e szeroko kolumn jest wystarczajca dla podsumowa
    GrandRow = Range("A65536").End(xlUp).Row
    Cells(3, 3).Resize(GrandRow - 2, FinalCol - 2).Columns.AutoFit
    Cells(GrandRow, 3).Resize(1, FinalCol - 2).NumberFormat = "#,##0,K"
    ' Dodaj podzia strony przed wierszem Suma kocowa, w przeciwnym razie
    ' kierownik produktu z ostatniej linii otrzyma dwa podsumowania
    WSR.HPageBreaks.Add Before:=Cells(GrandRow, 1)

End Sub


Sub TwoDataFields()
    Dim WSD As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long

    Set WSD = Worksheets("TabelaPrzestawna")
    Dim WSR As Worksheet
    Dim WBO As Workbook
    Dim WBN As Workbook
    Set WBO = ActiveWorkbook

    ' Usu wszystkie wczeniejsze tabele przestawne
    For Each PT In WSD.PivotTables
        PT.TableRange2.Clear
    Next PT
    WSD.Range("R1:Z1").EntireColumn.Clear

    ' Zdefiniuj obszar danych wejciowych i skonfiguruj pami podrczn tabeli przestawnej
    FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = WSD.Cells(1, Application.Columns.Count). _
        End(xlToLeft).Column
    Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
        xlDatabase, SourceData:=PRange.Address)

    ' Utwrz tabel przestawn z pamici podrcznej
    Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
        Cells(2, FinalCol + 2), TableName:="TabelaPrzestawna1")

    ' Wycz aktualizacj na czas budowania tabeli
    PT.ManualUpdate = True

    ' Skonfiguruj pola wierszy
    PT.AddFields RowFields:="Rynek", ColumnFields:="Data"

    ' Define Calculated Fields
    PT.CalculatedFields.Add Name:="redniaCena", Formula:="=Dochd/Sztuk"

    ' Skonfiguruj pola danych
    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
        .NumberFormat = "#,##0"
    End With

    With PT.PivotFields("Sztuk")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 2
        .NumberFormat = "#,##0"
    End With

    With PT.PivotFields("redniaCena")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 3
        .NumberFormat = "#,##0.00"
        .Name = "r. cena"
    End With

    ' Upewnij si, e w obszarze danych zamiast pustych komrek s zera
    PT.NullString = "0"

    ' Przelicz tabel przestawn
    PT.ManualUpdate = False
    PT.ManualUpdate = True

    WSD.Activate
    Range("M1").Select

End Sub

Sub CalcItemsProblem()
    Dim WSD As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long

    Set WSD = Worksheets("TabelaPrzestawna")
    Dim WSR As Worksheet

    ' Usu wszystkie wczeniejsze tabele przestawne
    For Each PT In WSD.PivotTables
        PT.TableRange2.Clear
    Next PT
    WSD.Range("R1:Z1").EntireColumn.Clear

    ' Zdefiniuj obszar danych wejciowych i skonfiguruj pami podrczn tabeli przestawnej
    FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = WSD.Cells(1, Application.Columns.Count). _
        End(xlToLeft).Column
    Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
        xlDatabase, SourceData:=PRange.Address)

    ' Utwrz tabel przestawn z pamici podrcznej
    Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
        Cells(2, FinalCol + 2), TableName:="TabelaPrzestawna1")

    ' Wycz aktualizacj na czas budowania tabeli
    PT.ManualUpdate = True

    ' Skonfiguruj pola wierszy
    PT.AddFields RowFields:="Produkt"

    ' Zdefiniuj element obliczeniowy w wymiarze produktu
    PT.PivotFields("Produkt").CalculatedItems _
        .Add "Grupa Plants", "='Landscaping/Grounds Care'+'Green Plants and Foliage Care'"
    ' Zmie kolejno, aby drukarki i kopiarki byy na pocztku
    PT.PivotFields("Produkt"). _
        PivotItems("Landscaping/Grounds Care").Position = 1
    PT.PivotFields("Produkt"). _
        PivotItems("Green Plants and Foliage Care").Position = 2
    PT.PivotFields("Produkt"). _
        PivotItems("Grupa Plants").Position = 3

    ' Skonfiguruj pola danych
    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
        .NumberFormat = "#,##0"
    End With

    ' Upewnij si, e w obszarze danych zamiast pustych komrek s zera
    PT.NullString = "0"


    ' Przelicz tabel przestawn
    PT.ManualUpdate = False
    PT.ManualUpdate = True
    WSD.Activate
    Range("M1").Select

End Sub

Sub CalcItemsFixed()
    Dim WSD As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long

    Set WSD = Worksheets("TabelaPrzestawna")
    Dim WSR As Worksheet

    ' Usu wszystkie wczeniejsze tabele przestawne
    For Each PT In WSD.PivotTables
        PT.TableRange2.Clear
    Next PT
    WSD.Range("R1:Z1").EntireColumn.Clear

    ' Zdefiniuj obszar danych wejciowych i skonfiguruj pami podrczn tabeli przestawnej
    FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = WSD.Cells(1, Application.Columns.Count). _
        End(xlToLeft).Column
    Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
        xlDatabase, SourceData:=PRange.Address)

    ' Utwrz tabel przestawn z pamici podrcznej
    Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
        Cells(2, FinalCol + 2), TableName:="TabelaPrzestawna1")

    ' Wycz aktualizacj na czas budowania tabeli
    PT.ManualUpdate = True

    ' Skonfiguruj pola wierszy
    PT.AddFields RowFields:="Produkt"

    ' Zdefiniuj element obliczeniowy w wymiarze produktu
    PT.PivotFields("Produkt").CalculatedItems _
        .Add "Grupa Plants", "='Landscaping/Grounds Care'+'Green Plants and Foliage Care'"
    ' Zmie kolejno, aby drukarki i kopiarki byy na pocztku
    PT.PivotFields("Produkt"). _
        PivotItems("Landscaping/Grounds Care").Position = 1
    PT.PivotFields("Produkt"). _
        PivotItems("Green Plants and Foliage Care").Position = 2
    PT.PivotFields("Produkt"). _
        PivotItems("Grupa Plants").Position = 3

    ' Skonfiguruj pola danych
    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
        .NumberFormat = "#,##0"
    End With

    ' Upewnij si, e w obszarze danych zamiast pustych komrek s zera
    PT.NullString = "0"

    With PT.PivotFields("Produkt")
        .PivotItems("Landscaping/Grounds Care").Visible = False
        .PivotItems("Green Plants and Foliage Care").Visible = False
    End With


    ' Przelicz tabel przestawn
    PT.ManualUpdate = False
    PT.ManualUpdate = True
    WSD.Activate
    Range("M1").Select

End Sub

Sub ReportByMonth()
    Dim WSD As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long

    Set WSD = Worksheets("TabelaPrzestawna")
    Dim WSR As Worksheet

    ' Usu wszystkie wczeniejsze tabele przestawne
    For Each PT In WSD.PivotTables
        PT.TableRange2.Clear
    Next PT
    WSD.Range("M1:Z1").EntireColumn.Clear

    ' Zdefiniuj obszar danych wejciowych i skonfiguruj pami podrczn tabeli przestawnej
    FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = WSD.Cells(1, Application.Columns.Count). _
        End(xlToLeft).Column
    Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
        xlDatabase, SourceData:=PRange.Address)

    ' Utwrz tabel przestawn z pamici podrcznej
    Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
        Cells(2, FinalCol + 2), TableName:="TabelaPrzestawna1")

    ' Wycz aktualizacj na czas budowania tabeli
    PT.ManualUpdate = True

    ' Skonfiguruj pola wierszy
    PT.AddFields RowFields:="Data bilansu", ColumnFields:="Region"

    ' Skonfiguruj pola danych
    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
        .NumberFormat = "#,##0"
    End With

    ' Upewnij si, e w obszarze danych zamiast pustych komrek s zera
    PT.NullString = "0"

    ' Przelicz tabel przestawn aby umoliwi narysowanie etykiet dat
    PT.ManualUpdate = False
    PT.ManualUpdate = True
    WSD.Activate

    ' Pogrupuj dat wysyki wedug miesicy, kwartaw i lat
    PT.PivotFields("Data bilansu").LabelRange.Group Start:=True, _
        End:=True, Periods:= _
        Array(False, False, False, False, True, True, True)

    ' Przelicz tabel przestawn
    PT.ManualUpdate = False
    PT.ManualUpdate = True
    WSD.Activate
    Range("M1").Select

End Sub

Sub ReportByWeek()
    Dim WSD As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long

    Set WSD = Worksheets("TabelaPrzestawna")
    Dim WSR As Worksheet

    ' Usu wszystkie wczeniejsze tabele przestawne
    For Each PT In WSD.PivotTables
        PT.TableRange2.Clear
    Next PT
    WSD.Range("M1:Z1").EntireColumn.Clear

    ' Zdefiniuj obszar danych wejciowych i skonfiguruj pami podrczn tabeli przestawnej
    FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = WSD.Cells(1, Application.Columns.Count). _
        End(xlToLeft).Column
    Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
        xlDatabase, SourceData:=PRange.Address)

    ' Utwrz tabel przestawn z pamici podrcznej
    Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
        Cells(2, FinalCol + 2), TableName:="TabelaPrzestawna1")

    ' Wycz aktualizacj na czas budowania tabeli
    PT.ManualUpdate = True

    ' Skonfiguruj pola wierszy
    PT.AddFields RowFields:="Data bilansu", ColumnFields:="Region"

    ' Skonfiguruj pola danych
    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
        .NumberFormat = "#,##0"
    End With

    ' Upewnij si, e w obszarze danych zamiast pustych komrek s zera
    PT.NullString = "0"

    ' Przelicz tabel przestawn aby umoliwi narysowanie etykiet dat
    PT.ManualUpdate = False
    PT.ManualUpdate = True
    WSD.Activate

    ' Grupuj daty wedug tygodni.
    ' Okrel pierwszy poniedziaek przed dat minimaln
    FirstDate = PT.PivotFields("Data bilansu").LabelRange. _
        Offset(1, 0).Value
    WhichDay = Application.WorksheetFunction.Weekday(FirstDate, 3)
    StartDate = FirstDate - WhichDay
    PT.PivotFields("Data bilansu").LabelRange.Group _
        Start:=StartDate, End:=True, By:=7, _
        Periods:=Array(False, False, False, True, False, False, False)

    ' Przelicz tabel przestawn
    PT.ManualUpdate = False
    PT.ManualUpdate = True
    WSD.Activate
    Range("M1").Select

End Sub


Sub Top5Markets()
    ' Utwrz raport 5 najlpeszych rynkw
    Dim WSD As Worksheet
    Dim WSR As Worksheet
    Dim WBN As Workbook
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long
    Set WSD = Worksheets("TabelaPrzestawna")

    ' Usu wszystkie wczeniejsze tabele przestawne
    For Each PT In WSD.PivotTables
        PT.TableRange2.Clear
    Next PT
    WSD.Range("M1:Z1").EntireColumn.Clear

    ' Zdefiniuj obszar danych wejciowych i skonfiguruj pami podrczn tabeli przestawnej
    FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = WSD.Cells(1, Application.Columns.Count). _
        End(xlToLeft).Column
    Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
        xlDatabase, SourceData:=PRange.Address)

    ' Utwrz tabel przestawn z pamici podrcznej
    Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
        Cells(2, FinalCol + 2), TableName:="TabelaPrzestawna1")

    ' Wycz aktualizacj na czas budowania tabeli
    PT.ManualUpdate = True

    ' Skonfiguruj pola wierszy
    PT.AddFields RowFields:="Rynek", ColumnFields:="Linia biznesowa"

    ' Skonfiguruj pola danych
    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
        .NumberFormat = "#,##0"
        .Name = "Suma z Dochd"
    End With

    ' Upewnij si, e w obszarze danych zamiast pustych komrek s zera
    PT.NullString = "0"

    ' Posortuj rynki malejco wedug dochodw
    PT.PivotFields("Rynek").AutoSort Order:=xlDescending, _
        Field:="Suma z Dochd"

    ' poka tylko 5 pierwszych rynkw
    PT.PivotFields("Market").AutoShow Type:=xlAutomatic, Range:=xlTop, _
        Count:=5, Field:="Suma z Dochd"

    ' Przelicz tabel przestawn aby umoliwi narysowanie etykiet dat
    PT.ManualUpdate = False
    PT.ManualUpdate = True

    ' Utwrz pusty skoroszyt z jednym arkuszem
    Set WBN = Workbooks.Add(xlWBATWorksheet)
    Set WSR = WBN.Worksheets(1)
    WSR.Name = "Raport"
    ' Ustaw tytu raportu
    With WSR.[A1]
        .Value = "5 najlepszych rynkw"
        .Font.Size = 14
    End With

    ' Skopiuj dane tabeli przestawnej do wiersza 3 na arkuszu raportu
    ' Uyj przesunicia do wyeliminowania wiersza tytuu tabeli przestawnej
    PT.TableRange2.Offset(1, 0).Copy
    WSR.[A3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    LastRow = WSR.Cells(65536, 1).End(xlUp).Row
    WSR.Cells(LastRow, 1).Value = "Suma pierwszych 5"

    ' Wr do tabeli przestawnej aby uzyska sumy bez autopokazywania
    PT.PivotFields("Rynek").Orientation = xlHidden
    PT.ManualUpdate = False
    PT.ManualUpdate = True
    PT.TableRange2.Offset(2, 0).Copy
    WSR.Cells(LastRow + 2, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    WSR.Cells(LastRow + 2, 1).Value = "Suma dla firmy"

    ' Wyczyszczenie tabeli przestawnej
    PT.TableRange2.Clear
    Set PTCache = Nothing

    ' Podstawowe formatowanie.
    ' Ustaw autodopasowanie kolumn, pogrub nagwki i wyrwnaj je do prawej
    WSR.Range(WSR.Range("A3"), WSR.Cells(LastRow + 2, 6)).Columns.AutoFit
    Range("A3").EntireRow.Font.Bold = True
    Range("A3").EntireRow.HorizontalAlignment = xlRight
    Range("A3").HorizontalAlignment = xlLeft

    Range("A2").Select
    MsgBox "Raport dla zarzdu zosta utworzony"

End Sub

Sub RetrieveTop3CustomerDetail()
    ' Pobranie szczegw z pierwszych 3 klientw
    Dim WSD As Worksheet
    Dim WSR As Worksheet
    Dim WBN As Workbook
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long
    Set WSD = Worksheets("TabelaPrzestawna")

    ' Usu wszystkie wczeniejsze tabele przestawne
    For Each PT In WSD.PivotTables
        PT.TableRange2.Clear
    Next PT
    WSD.Range("R1:Z1").EntireColumn.Clear

    ' Zdefiniuj obszar danych wejciowych i skonfiguruj pami podrczn tabeli przestawnej
    FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = WSD.Cells(1, Application.Columns.Count). _
        End(xlToLeft).Column
    Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
        xlDatabase, SourceData:=PRange.Address)

    ' Utwrz tabel przestawn z pamici podrcznej
    Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
        Cells(2, FinalCol + 2), TableName:="TabelaPrzestawna1")

    ' Wycz aktualizacj na czas budowania tabeli
    PT.ManualUpdate = True

    ' Skonfiguruj pola wierszy
    PT.AddFields RowFields:="Klient"

    ' Skonfiguruj pola danych
    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
        .NumberFormat = "#,##0"
        .Name = "Suma z dochd"
    End With

    ' Posortuj klientw wedug malejcych dochodw
    PT.PivotFields("Klient").AutoSort Order:=xlDescending, _
        Field:="Suma z Dochd"

    ' Poka tylko 3 pierwszych klientw
    PT.PivotFields("Klient").AutoShow Type:=xlAutomatic, Range:=xlTop, _
        Count:=3, Field:="Suma z Dochd"

    ' Upewnij si, e w obszarze danych zamiast pustych komrek s zera
    PT.NullString = "0"

    ' Przelicz tabel przestawn aby umoliwi narysowanie etykiet dat
    PT.ManualUpdate = False
    PT.ManualUpdate = True

    ' Utwrz raporty dla kadego klienta
    For i = 1 To 3
        PT.TableRange2.Offset(i + 1, 1).Resize(1, 1).ShowDetail = True
        ' Aktywny arkusz zosta zmieniony na nowy szczegowy raport
        ' Dodaj tytu
        Range("A1:A2").EntireRow.Insert
        Range("A1").Value = "Szczegy dla " & _
            PT.TableRange2.Offset(i + 1, 0).Resize(1, 1).Value & _
            " (Pozycja sklepu: " & i & ")"
    Next i

    MsgBox "Raporty dla 3 najlepszych sklepw zostay utworzone."

End Sub


Sub Top5ByRegionReport()
    ' Utwrz raport z 5 najlepszych klientw dla kadego regionu
    Dim WSD As Worksheet
    Dim WSR As Worksheet
    Dim WBN As Workbook
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long

    Set WSD = Worksheets("TabelaPrzestawna")

    ' Usu wszystkie wczeniejsze tabele przestawne
    For Each PT In WSD.PivotTables
        PT.TableRange2.Clear
    Next PT
    WSD.Range("R1:Z1").EntireColumn.Clear

    ' Zdefiniuj obszar danych wejciowych i skonfiguruj pami podrczn tabeli przestawnej
    FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = WSD.Cells(1, Application.Columns.Count). _
        End(xlToLeft).Column
    Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
        xlDatabase, SourceData:=PRange.Address)

    ' Utwrz tabel przestawn z pamici podrcznej
    Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
        Cells(2, FinalCol + 2), TableName:="TabelaPrzestawna1")

    ' Wycz aktualizacj na czas budowania tabeli
    PT.ManualUpdate = True

    ' Skonfiguruj pola wierszy
    PT.AddFields RowFields:="Klient", PageFields:="Region"

    ' Skonfiguruj pola danych
    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
        .NumberFormat = "#,##0,K"
        .Name = "Suma z Dochd"
    End With

    ' Posortuj klientw malejco wedug dochodw
    PT.PivotFields("Klient").AutoSort Order:=xlDescending, _
        Field:="Suma z Dochd"

    ' Poka tylko 5 pierwszych klientw
    PT.PivotFields("Klient").AutoShow Type:=xlAutomatic, Range:=xlTop, _
        Count:=5, Field:="Suma z Dochd"

    ' Upewnij si, e w obszarze danych zamiast pustych komrek s zera
    PT.NullString = "0"

    ' Przelicz tabel przestawn
    PT.ManualUpdate = False
    PT.ManualUpdate = True
    Ctr = 0

    ' Ptla po wszystkich regionach
    For Each PivItem In PT.PivotFields("Region").PivotItems
        Ctr = Ctr + 1
        PT.PivotFields("Region").CurrentPage = PivItem.Name
        PT.ManualUpdate = False
        PT.ManualUpdate = True

        ' Utwrz pusty skoroszyt z jednym arkuszem
        Set WBN = Workbooks.Add(xlWBATWorksheet)
        Set WSR = WBN.Worksheets(1)
        WSR.Name = PivItem.Name
        ' Set up Title for Report
        With WSR.[A1]
            .Value = "Pierwszych 5 klientw w regionie " & PivItem.Name
            .Font.Size = 14
        End With

        ' Skopiuj dane tabeli przestawnej do wiersza 3 na arkuszu raportu
        ' Uyj funkcji Offset do wyeliminowania wierszy strony i tytuu
        PT.TableRange2.Offset(3, 0).Copy
        WSR.[A3].PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        LastRow = WSR.Cells(65536, 1).End(xlUp).Row
        WSR.Cells(LastRow, 1).Value = "Suma pierwszych 5"

        ' Podstawowe formatowanie.
        ' Ustaw autodopasowanie kolumn, pogrub nagwki i wyrwnaj je do prawej
        WSR.Range(WSR.Range("A2"), WSR.Cells(LastRow, 3)).Columns.AutoFit
        Range("A3").EntireRow.Font.Bold = True
        Range("A3").EntireRow.HorizontalAlignment = xlRight
        Range("A3").HorizontalAlignment = xlLeft
        Range("B3").Value = "Dochd"

        Range("A2").Select

    Next PivItem

    ' Wyczy tabel przestawn
    PT.TableRange2.Clear
    Set PTCache = Nothing

    MsgBox Ctr & " Raporty regionalne zostay utworzone"

End Sub

Sub SumAvgCount()
    Dim WSD As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long

    Set WSD = Worksheets("TabelaPrzestawna")
    Dim WSR As Worksheet

    ' Usu wszystkie wczeniejsze tabele przestawne
    For Each PT In WSD.PivotTables
        PT.TableRange2.Clear
    Next PT
    WSD.Range("R1:Z1").EntireColumn.Clear

    ' Zdefiniuj obszar danych wejciowych i skonfiguruj pami podrczn tabeli przestawnej
    FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = WSD.Cells(1, Application.Columns.Count). _
        End(xlToLeft).Column
    Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
        xlDatabase, SourceData:=PRange.Address)

    ' Utwrz tabel przestawn z pamici podrcznej
    Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
        Cells(2, FinalCol + 2), TableName:="TabelaPrzestawna1")

    ' Wycz aktualizacj na czas budowania tabeli
    PT.ManualUpdate = True

    ' Skonfiguruj pola wierszy
    PT.AddFields RowFields:="Region", ColumnFields:="Data"

    ' Skonfiguruj pola danych
    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
        .NumberFormat = "#,##0,K"
        .Name = "Suma z Dochd"
    End With

    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlCount
        .Position = 2
        .NumberFormat = "#,##0"
        .Name = "Liczba zamwie"
    End With

    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlAverage
        .Position = 3
        .NumberFormat = "#,##0"
        .Name = "redni dochd"
    End With

    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlMin
        .Position = 4
        .NumberFormat = "#,##0,K"
        .Name = "Najmniejsze zamwienie"
    End With

    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlMax
        .Position = 5
        .NumberFormat = "#,##0"
        .Name = "Najwiksze zamwienie"
    End With

    ' Upewnij si, e w obszarze danych zamiast pustych komrek s zera
    PT.NullString = "0"


    ' Przelicz tabel przestawn aby umoliwi narysowanie etykiet dat
    PT.ManualUpdate = False
    PT.ManualUpdate = True

    ' Zastosuj sortowanie rczne
    On Error Resume Next
    PT.PivotFields("Region").PivotItems("South").Position = 1
    On Error GoTo 0


    ' Przelicz tabel przestawn
    PT.ManualUpdate = False
    PT.ManualUpdate = True
    WSD.Activate
    Range("M1").Select

    MsgBox "Zwr uwag, e Region jest posortowany rcznie, z South na pierwszej pozycji."

End Sub

Sub ReportPcts()
    Dim WSD As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long

    Set WSD = Worksheets("TabelaPrzestawna")
    Dim WSR As Worksheet

    ' Usu wszystkie wczeniejsze tabele przestawne
    For Each PT In WSD.PivotTables
        PT.TableRange2.Clear
    Next PT
    WSD.Range("R1:Z1").EntireColumn.Clear

    ' Zdefiniuj obszar danych wejciowych i skonfiguruj pami podrczn tabeli przestawnej
    FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = WSD.Cells(1, Application.Columns.Count). _
        End(xlToLeft).Column
    Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
        xlDatabase, SourceData:=PRange.Address)

    ' Utwrz tabel przestawn z pamici podrcznej
    Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
        Cells(2, FinalCol + 2), TableName:="TabelaPrzestawna1")

    ' Wycz aktualizacj na czas budowania tabeli
    PT.ManualUpdate = True

    ' Skonfiguruj pola wierszy
    PT.AddFields RowFields:="Data faktury"

    ' Skonfiguruj pola danych
    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
        .NumberFormat = "#,##0,K"
    End With

    ' Upewnij si, e w obszarze danych zamiast pustych komrek s zera
    PT.NullString = "0"

    ' Przelicz tabel przestawn aby umoliwi narysowanie etykiet dat
    PT.ManualUpdate = False
    PT.ManualUpdate = True

    ' Pogrupuj pole Data wysyki wedug miesicy, kwartaw i lat
    PT.PivotFields("Data faktury").LabelRange.Group Start:=True, _
        End:=True, Periods:= _
        Array(False, False, False, False, True, False, True)

    ' Ustaw procent sumy
    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Caption = "ProcentSumy"
        .Function = xlSum
        .Position = 2
        .NumberFormat = "#0.0%"
        .Calculation = xlPercentOfTotal
    End With

    ' Ustaw zmian procentow od poprzedniego miesica
    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlSum
        .Caption = "%Change"
        .Calculation = xlPercentDifferenceFrom
        .BaseField = "Data faktury"
        .BaseItem = "(poprzedni)"
        .Position = 3
        .NumberFormat = "#0.0%"
    End With

    ' Ustaw sum biec
    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlSum
        .Caption = "Suma YTD"
        .Calculation = xlRunningTotal
        .Position = 4
        .NumberFormat = "#,##0,K"
        .BaseField = "Data faktury"
    End With


    ' Przelicz tabel przestawn
    PT.ManualUpdate = False
    PT.ManualUpdate = True
    WSD.Activate
    Range("M1").Select

End Sub


Sub PivotExcel97Compatible()
    ' Pivot Table Code for Excel 97 Users
    Dim WSD As Worksheet
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long

    Set WSD = Worksheets("TabelaPrzestawna")

    ' Usu wszystkie wczeniejsze tabele przestawne
    For Each PT In WSD.PivotTables
        PT.TableRange2.Clear
    Next PT
    WSD.Range("M1:Z1").EntireColumn.Clear

    ' Zdefiniuj obszar wejciowy
    FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = WSD.Cells(1, Application.Columns.Count). _
        End(xlToLeft).Column
    Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)

    ' Utwrz tabel przestawn za pomoc PivotTableWizard
    Set PT = WSD.PivotTableWizard(SourceType:=xlDatabase, _
        SourceData:=PRange.Address, _
        TableDestination:="R2C13", TableName:="TabelaPrzestawna1")

    PT.ManualUpdate = True
    ' Skonfiguruj pola wierszy
    PT.AddFields RowFields:="Region", ColumnFields:="Linia produktowa"

    ' Skonfiguruj pola danych
    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
        .NumberFormat = "#,##0,K"
        .Name = "Suma z Dochd"
    End With

    PT.ManualUpdate = False
    PT.ManualUpdate = True
    WSD.Activate
    Range("M1").Select

End Sub


Sub CreatePivotDataBar()
    Dim WSD As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long
    
    Set WSD = Worksheets("TabelaPrzestawna")
    
    ' Usu wszystkie wczeniejsze tabele przestawne
    For Each PT In WSD.PivotTables
        PT.TableRange2.Clear
    Next PT
   
    WSD.Range("R1:AZ1").EntireColumn.Clear
    
    ' Zdefiniuj obszar wejciowy i skonfiguruj tabel przestawn
    FinalRow = WSD.Cells(Rows.Count, 1).End(xlUp).Row
    FinalCol = WSD.Cells(1, Columns.Count). _
        End(xlToLeft).Column
    Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:= _
    xlDatabase, SourceData:=PRange.Address)
    
    ' Utwrz tabel przestawn z pamici podrcznej
    Set PT = PTCache.CreatePivotTable(TableDestination:=WSD. _
    Cells(2, FinalCol + 2), TableName:="PivotTable1")
    
    ' Wycz aktualizacj na czas budowania tabeli
    PT.ManualUpdate = True
    
    ' Skonfiguruj pola wierszy i kolumn
    PT.AddFields RowFields:="Ga", _
    ColumnFields:="Data"
    
    ' Skonfiguruj pola danych
    With PT.PivotFields("Dochd")
        .Orientation = xlDataField
        .Function = xlSum
        .Position = 1
    End With
    
    ' Przelicz tabel przestawn
    PT.ManualUpdate = False
    PT.ManualUpdate = True
    
    ' Uyj paska danych
    PT.TableRange2.Cells(3, 2).Select
    Selection.FormatConditions.AddDatabar
    Selection.FormatConditions(1).ShowValue = True
    Selection.FormatConditions(1).SetFirstPriority
    With Selection.FormatConditions(1)
        .MinPoint.Modify newtype:=xlConditionValueLowestValue
        .MaxPoint.Modify newtype:=xlConditionValueHighestValue
    End With
    
    With Selection.FormatConditions(1).BarColor
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = -0.499984740745262
    End With
    Selection.FormatConditions(1).ScopeType = xlFieldsScope
    
    WSD.Activate
    Range("M1").Select
End Sub








