Tilrettelse af Macro - Excel 2007

ja, den var ikke lang, må vi se mere

Flot klaret, nu med koden

Sub Makro2()
'
' Makro2 Makro
'

'
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "DATA!R1C1:R4688C12", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="Ark5!R3C1", TableName:="Pivottabel2", DefaultVersion:= _
        xlPivotTableVersion12
    Sheets("Ark5").Select
    Cells(3, 1).Select
    Range("B6").Select
    With ActiveSheet.PivotTables("Pivottabel2")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    With ActiveSheet.PivotTables("Pivottabel2").PivotFields("Varenr")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Pivottabel2").PivotFields("Lokation")
        .Orientation = xlRowField
        .Position = 2
    End With
    Range("A5").Select
    ActiveSheet.PivotTables("Pivottabel2").PivotFields("Varenr").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
End Sub

Hvis der altid er data i L kolonnen, burde denne virke.

NB. ikke testet

Sub Makro2()
'
' Makro2 Makro
Dim RK As Long
RK = Range("L65536").End(xlUp).Row ' ret  kolonne L til en anden, hvis der ille altid er data i sidste celle
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "DATA!R1C1:R" & RK & "C12", Version:=xlPivotTableVersion12).CreatePivotTable _
        TableDestination:="Ark5!R3C1", TableName:="Pivottabel2", DefaultVersion:= _
        xlPivotTableVersion12
    Sheets("Ark5").Select
    Cells(3, 1).Select
    Range("B6").Select
    With ActiveSheet.PivotTables("Pivottabel2")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    With ActiveSheet.PivotTables("Pivottabel2").PivotFields("Varenr")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("Pivottabel2").PivotFields("Lokation")
        .Orientation = xlRowField
        .Position = 2
    End With
    Range("A5").Select
    ActiveSheet.PivotTables("Pivottabel2").PivotFields("Varenr").Subtotals = Array( _
        False, False, False, False, False, False, False, False, False, False, False, False)
End Sub

Det virker.
Tak

Ligger du et svar?

et svar ;-))