Problemer med pivottabeller hvor dataområdet ændre størrelse

Prøv med

ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        worksheets("Ark1").Range("A1").CurrentRegion).CreatePivotTable TableDestination:="", TableName:= _
        "Pivottabel1", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select


Forudsætter at dine data findes i Ark1 og starter i A1.

SUPER det virker.

Ved du hvordan man kan sætte et bestemt navn på den nye faneblad (det nye faneblad med den nyoprettede pivottabellen oprettes i) ?

Hvordan giver jeg dig point her på siden (er ikke så rutineret i det her :-) )

Bliver der oprettet en ny arkfane?
Har du hele koden med her?
Du giver point ved at acceptere dette svar.

Ja der bliver oprettet et nyt arkfane, hvilket også er helt OK for mig.
Nej det er ikke alle koder, men jer er ikke ved min alm. PC'er før på mandag, så der sender jeg lige hele koden.

Endnu engang TAK for hjælpen.

Hej Igen

Her er hele koden. Spørgsmålet var hvordan man kan give det nye faneblad med Pivottabellen et navn.

--------------
Sub Prkvtudvidet()
'
' Prkvtudvidet Makro
' Makro indspillet 18-02-2010 af BR
'
' Genvejstast:Ctrl+z
'
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        Worksheets("Data").Range("A1").CurrentRegion).CreatePivotTable TableDestination:="", TableName:= _
        "Pivottabel3", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    ActiveSheet.PivotTables("Pivottabel3").PivotFields("Kvartal").Subtotals = Array _
        (False, True, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("Pivottabel3").PivotFields("Kanal").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("Pivottabel3").PivotFields("Overførselstype"). _
        Subtotals = Array(False, True, False, False, False, False, False, False, False, False, _
        False, False)
    ActiveSheet.PivotTables("Pivottabel3").PivotFields("Valuta").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("Pivottabel3").AddFields RowFields:=Array("Kvartal", _
        "Overførselstype", "Valuta", "Kanal", "Data"), PageFields:="Kundenavn"
    With ActiveSheet.PivotTables("Pivottabel3").PivotFields("Antal")
        .Orientation = xlDataField
        .Position = 1
        .NumberFormat = "#"
    End With
    With ActiveSheet.PivotTables("Pivottabel3").PivotFields("Beløb i DKK")
        .Orientation = xlDataField
        .NumberFormat = "#"
    End With
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.393700787401575)
        .RightMargin = Application.InchesToPoints(0.393700787401575)
        .TopMargin = Application.InchesToPoints(0.393700787401575)
        .BottomMargin = Application.InchesToPoints(0.393700787401575)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
    End With
    Range("E3").Select
    With ActiveSheet.PivotTables("Pivottabel3").DataPivotField
        .Orientation = xlColumnField
        .Position = 1
    End With
    Columns("B:B").ColumnWidth = 31.14
    Range("A1").Select
    With Selection.Interior
        .ColorIndex = 37
        .Pattern = xlSolid
    End With
    ActiveSheet.PivotTables("Pivottabel3").PivotSelect "Kvartal[All;Sum]", _
        xlDataAndLabel, True
    With Selection.Interior
        .ColorIndex = 37
        .Pattern = xlSolid
    End With
    ActiveSheet.PivotTables("Pivottabel3").PivotSelect "Overførselstype[All;Sum]", _
        xlDataAndLabel, True
    With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
    End With
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 18
    ActiveWindow.ScrollRow = 25
    ActiveWindow.ScrollRow = 30
    ActiveWindow.ScrollRow = 34
    ActiveWindow.ScrollRow = 39
    ActiveWindow.ScrollRow = 45
    ActiveWindow.ScrollRow = 46
    ActiveWindow.ScrollRow = 47
    ActiveWindow.ScrollRow = 48
    ActiveWindow.ScrollRow = 49
    ActiveSheet.PivotTables("Pivottabel3").PivotSelect "'Column Grand Total'", _
        xlDataAndLabel, True
    With Selection.Interior
        .ColorIndex = 36
        .Pattern = xlSolid
    End With
    ActiveWindow.ScrollRow = 48
    ActiveWindow.ScrollRow = 47
    ActiveWindow.ScrollRow = 46
    ActiveWindow.ScrollRow = 45
    ActiveWindow.ScrollRow = 44
    ActiveWindow.ScrollRow = 43
    ActiveWindow.ScrollRow = 41
    ActiveWindow.ScrollRow = 40
    ActiveWindow.ScrollRow = 39
    ActiveWindow.ScrollRow = 38
    ActiveWindow.ScrollRow = 37
    ActiveWindow.ScrollRow = 36
    ActiveWindow.ScrollRow = 35
    ActiveWindow.ScrollRow = 34
    ActiveWindow.ScrollRow = 32
    ActiveWindow.ScrollRow = 31
    ActiveWindow.ScrollRow = 29
    ActiveWindow.ScrollRow = 28
    ActiveWindow.ScrollRow = 27
    ActiveWindow.ScrollRow = 26
    ActiveWindow.ScrollRow = 25
    ActiveWindow.ScrollRow = 24
    ActiveWindow.ScrollRow = 23
    ActiveWindow.ScrollRow = 22
    ActiveWindow.ScrollRow = 21
    ActiveWindow.ScrollRow = 20
    ActiveWindow.ScrollRow = 19
    ActiveWindow.ScrollRow = 18
    ActiveWindow.ScrollRow = 17
    ActiveWindow.ScrollRow = 16
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 14
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 7
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 1
    ActiveWorkbook.ShowPivotTableFieldList = False
End Sub