Sub Creo_Pivot()      Dim wb As Workbook
    Dim ws As Worksheet
    Dim oPvtCch As PivotCache
    Dim oPvtTbl As PivotTable
    Dim rng As Range
    Dim r As Long
    
    

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Dbase")
    r = ws.Cells(Rows.Count, 25).End(xlUp).Row    sono le colonne che importo 
    Set rng = ws.Range("A1:Y" & r)
    Set oPvtCch = wb.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=rng)    'crea cache per tabella dal range
    Set oPvtTbl = oPvtCch.CreatePivotTable("")    'crea pivot in nuovo foglio
    With oPvtTbl.Parent
        .PivotTableWizard TableDestination:=oPvtTbl.Parent.Cells(3, 1)
        .Name = "Ore famiglia"    'controlla che la pivot sia quella giusta
    End With
    With oPvtTbl
        .Name = "Ore famiglia" 'rinomino la tabella, serve per la seconda routine
         .PivotFields("Famiglia").Orientation = xlPageField 'campo in filtro di rapporto
        .PivotFields("Famiglia").Position = 1 'posizione 1
        .PivotFields("Causale Doc.").Orientation = xlRowField ' campo in etichette di riga
        .PivotFields("Causale Doc.").Position = 1
        .PivotFields("Attività").Orientation = xlRowField 'campo in etichette di riga
        .PivotFields("Attività").Position = 2 'posizione 2
        .AddDataField .PivotFields("Tempo"), "Somma di tempo", xlSum 'aggiungo somma del campo ("")
        .ColumnGrand = False ' tolgo i totali per colonna
        .RowGrand = False     ' tolgo i totali per riga
      End With
         'poi mi fermo perchè non riesco a creare altri fogli.

Option Explicit

Sub Pivot_Saldat()

  Dim oPvtCch As PivotCache
  Dim oPvtTbl As PivotTable
  Dim ptField As PivotField
  Dim ptItem As PivotItem
  Dim wsDati As Worksheet
  Dim rngDati As Range
  
  Set wsDati = Worksheets("Foglio1") '"iltuofoglio"
  Set rngDati = wsDati.Range("A1:R10") '"iltuorange"
  Set oPvtCch = wsDati.Parent.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rngDati)   'crea cache per tabella dal range
  Set oPvtTbl = oPvtCch.CreatePivotTable(wsDati.Parent.Worksheets.Add.Cells(2, 2))  'crea pivot in nuovo foglio

  With oPvtTbl
    .RowAxisLayout xlOutlineRow
    .Name = wsDati.Name
    .PivotFields(7).Orientation = xlRowField    'Lato
    .PivotFields(7).Position = 1    'Lato come primo elemento
    .PivotFields(1).Orientation = xlRowField    'Conto
    .PivotFields(1).Position = 2    'Conto secondo elemento
    .PivotFields(2).Orientation = xlRowField    'Descrizione
    .PivotFields(2).Position = 3    'Descrizione terzo elemento
    .PivotFields(4).Orientation = xlRowField    'Segno
    .PivotFields(4).Position = 4    'Segno quarto elemento
    .PivotFields(4).Caption = "Segno "    'Nome campo segno
        For Each ptItem In .PivotFields(4).PivotItems
             If ptItem.Caption = "(blank)" Then ptItem.Visible = False
        Next
    '.PivotFields(6).PivotItems("(blank)").Visible = False
    .AddDataField .PivotFields(5), "Importo", xlSum    'Somma importo
    .PivotFields("Importo").NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""??_);_(@_)"    'formatto importi
    .RowAxisLayout xlTabularRow
    .TableStyle2 = "PivotStyleMedium9"
    .PivotFields(7).PivotItems(1).Position = 1    'Metto in Testa Attivo
    'Modifica del 07/02/2013, in testa i Transitori
    .SubtotalLocation xlAtTop
    For Each ptField In .RowFields    'elimino i subtotali
      If ptField.Name <> "Lato" Then
        On Error Resume Next
        ptField.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
      End If
    Next ptField
  End With
  
  Set rngDati = Nothing
  Set wsDati = Nothing
  Set oPvtCch = Nothing
  Set oPvtTbl = Nothing
End Sub

Sub aggiorna()
  Dim wb As Workbook
  Dim ws As Worksheet, wsPvC As Worksheet
  
  Dim oPvTbl As PivotTable
  Dim oPvFld As PivotField
  Dim sCache As String
  Dim x As Long, y As Long
  Dim ass As String
  Set wb = ActiveWorkbook
  Set ws = wb.ActiveSheet
'  On Error Resume Next
  For Each ws In wb.Worksheets
    For Each oPvTbl In ws.PivotTables
      With oPvTbl
      
        'troviamo il nome del foglio di origine dati e diamogli una ripulita da caratteri speciali
        sCache = Replace(Left(.SourceData, InStr(1, .SourceData, "!", vbTextCompare) - 1), "'", "")
        x = Right(.SourceData, (Len(.SourceData) - InStrRev(.SourceData, "C", , vbTextCompare))) 'per trovare il numero ultima colonna della sourcedata
        
        'individuato il foglio di origine troviamo l'ultima riga piena di colonna A
        'questa parte è da implementare, il range di origine potrebbe non iniziare dalla prima
        'colonna e quindi bisognerebbe individuarla sempre dalla proprietà "Sourcedata" della pivot
        Set wsPvC = wb.Worksheets(sCache)
        With wsPvC
          y = .Range("A" & .Rows.Count).End(xlUp).Row
          
          'in maniera probabilmente maccheronica ricostruiamo la nuova pivotcache sulla base
          'dell'ultima riga trovata
          sCache = "'" & .Name & "'!R1C1:R" & y & "C" & x
        End With
        Set wsPvC = Nothing
        
        .SourceData = sCache 'qui il vero "refresh", sostituiamo la sourcedata
      End With
    Next oPvTbl
  Next ws
  Set ws = Nothing
  Set wb = Nothing
End Sub

Option Explicit

Sub Cache_Pivot()
  Dim wb As Workbook
  Dim ws As Worksheet
  Dim pvtTbl As PivotTable
  
  On Error Resume Next

  Set wb = ActiveWorkbook
  For Each ws In wb.Worksheets
    For Each pvtTbl In ws.PivotTables
      pvtTbl.PivotCache.Refresh
    Next pvtTbl
  Next ws
  Set wb = Nothing
End Sub

Option Explicit

Sub Cache_Pivot()
  Dim wb As Workbook
  Dim ws As Worksheet, wsPvC As Worksheet
  
  Dim oPvTbl As PivotTable
  Dim oPvFld As PivotField
  Dim sCache As String, sCol As String
  Dim x As Long, y As Long, k As Long
  Dim ass As String
  Set wb = ActiveWorkbook
  Set ws = wb.ActiveSheet
  On Error Resume Next
  For Each ws In wb.Worksheets
    For Each oPvTbl In ws.PivotTables
      If oPvTbl.Parent.Parent.Name = wb.Name Then
        With oPvTbl
          sCol = Right(.SourceData, Len(.SourceData) - InStr(1, .SourceData, "!", vbTextCompare))
          sCol = Left(sCol, InStr(1, sCol, ":", vbTextCompare) - 1)
          
          'troviamo il nome del foglio di origine dati e diamogli una ripulita da caratteri speciali
          sCache = Replace(Left(.SourceData, InStr(1, .SourceData, "!", vbTextCompare) - 1), "'", "")
          
          x = Right(.SourceData, (Len(.SourceData) - InStrRev(.SourceData, "C", , vbTextCompare))) 'per trovare il numero ultima colonna della sourcedata
          
          Set wsPvC = wb.Worksheets(sCache)
          With wsPvC
            y = .Range("A" & .Rows.Count).End(xlUp).Row
            sCache = "'" & .Name & "'!" & sCol & ":R" & y & "C" & x
          End With
          Set wsPvC = Nothing
          
          .SourceData = sCache 'qui il vero "refresh", sostituiamo la sourcedata
          .PivotCache.Refresh
        End With
      End If
    Next oPvTbl
  Next ws
  Set ws = Nothing
  Set wb = Nothing
End Sub

Sheets("Intestazione").Select ' apro la pagina d'instestazione e tolgo tutte le visualizzzioni
   With Application
      ActiveWindow.DisplayGridlines = False
      ActiveWindow.DisplayHeadings = False
      Application.DisplayFormulaBar = False
      Application.DisplayFullScreen = True  ' schermo intero
      ActiveWindow.DisplayWorkbookTabs = False
      .ScreenUpdating = False
   End With