Automatisk dannelse af lagkager

Jeg har et regneark hvor der er 3 selvstændige tabeller, hvorfra der skal dannes 3 grafer (lagkager). Tabellernes størrelse er ikke altid lige store eller indeholder samme mængde data. Men det problem har jeg i og for sig løst. Mit problem er at jeg har optaget hver enkelt lagkage som en makro, som jeg kalder én efter én, men den bruger altid de data som der dannes i den første ”lagkage”, hvilket betyder at de tre lagkager er ens. Jeg undskylder meget for længden af eksemplet………men har vedhæftet de første to lagkager

Sub Graftotal()

Range("a6").Select
Dim antal As Integer
antal = 5
 
  Do
    If ActiveCell.Value <> "" Then
        antal = antal + 1
    Else

    End If
    ActiveCell.Offset(1, 0).Select
  Loop Until ActiveCell.Value = ""
 
    Range("A6:a" & antal & ",F6:F" & antal).Select
    Range("F6").Activate
    Charts.Add
    ActiveChart.ChartType = xl3DPie
    ActiveChart.SetSourceData Source:=Sheets("oversigt").Range( _
        "A6:a" & antal & ",F6:F" & antal), PlotBy:=xlColumns
    ActiveChart.SeriesCollection(1).Name = "=oversigt!R3C5"
    ActiveChart.Location Where:=xlLocationAsObject, Name:="oversigt"
    With ActiveChart
        .ChartTitle.Characters.Text = "overskrift"
    End With
    ActiveChart.Legend.Select
    With Selection
        .Position = xlBottom
        .Font.Name = "arial"
        .Font.Size = 10
    End With
    ActiveSheet.Shapes("Chart 1").IncrementLeft -228.75
    ActiveSheet.Shapes("Chart 1").IncrementTop 49.5
    ActiveSheet.Shapes("Chart 1").ScaleWidth 0.67, msoFalse, msoScaleFromTopLeft
    ActiveSheet.Shapes("Chart 1").ScaleHeight 0.81, msoFalse, msoScaleFromTopLeft
    ActiveChart.Legend.Select
    With Selection.Border
        .LineStyle = xlNone
    End With
    Selection.Shadow = False
    Selection.Interior.ColorIndex = xlAutomatic
    ActiveChart.ChartArea.Select
    With Selection.Border
        .LineStyle = 0
    End With
        ActiveChart.PlotArea.Select
    With Selection.Border
        .LineStyle = xlNone
    End With
    With Selection.Interior
        .ColorIndex = 16
    End With
    ActiveChart.Legend.Select
    With Selection.Font
        .Name = "arial"
        .Size = 10
    End With
    ActiveChart.ChartTitle.Select
    With Selection.Font
        .Name = " arial "
        .Size = 11
    End With
   
    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveChart.ChartArea.Select

’Her bestemmer jeg placeringen af lagkagen.

With ActiveSheet.ChartObjects("chart 1")
    .Top = Range("a17").Top
    .Left = Range("a17").Left
    .Height = Range("a17:a31").Height
    .Width = Range("a17:f31").Width
End With
   
End Sub

Den næste ligner så i store træk…………………….


Sub Grafdel1()

Range("h6").Select
Dim antal As Integer
antal = 5
 
  Do
    If ActiveCell.Value <> "" Then
        antal = antal + 1
    Else

    End If
    ActiveCell.Offset(1, 0).Select
  Loop Until ActiveCell.Value = ""
 
    Range("h6:h" & antalx & ",k6:k" & antalx).Select
    Range("k6").Activate
    Charts.Add
    ActiveChart.ChartType = xl3DPie
    ActiveChart.SetSourceData Source:=Sheets("oversigt").Range( _
        "h6:a" & antalx & ",k6:k" & antalx), PlotBy:=xlColumns
    ActiveChart.SeriesCollection(1).Name = "=oversigt!R3C5"
    ActiveChart.Location Where:=xlLocationAsObject, Name:="oversigt"
    With ActiveChart
        .ChartTitle.Characters.Text = "del1"
    End With
    ActiveChart.Legend.Select
    With Selection
        .Position = xlBottom
        .Font.Name = "arial"
        .Font.Size = 10
    End With
ActiveSheet.Shapes("Chart 2").IncrementLeft 180.5
    ActiveSheet.Shapes("Chart 2").IncrementTop 57.25
    ActiveSheet.Shapes("Chart 2").ScaleWidth 0.42, msoFalse, msoScaleFromTopLeft
    ActiveSheet.Shapes("Chart 2").ScaleHeight 0.74, msoFalse, msoScaleFromTopLeft
    ActiveChart.Legend.Select
    With Selection.Border
        .LineStyle = xlNone
    End With
    Selection.Shadow = False
    Selection.Interior.ColorIndex = xlAutomatic
    ActiveChart.ChartArea.Select
    With Selection.Border
        .LineStyle = 0
    End With
        ActiveChart.PlotArea.Select
    With Selection.Border
        .LineStyle = xlNone
    End With
    With Selection.Interior
        .ColorIndex = 16
    End With
    ActiveChart.Legend.Select
    With Selection.Font
        .Name = "arial"
        .Size = 10
    End With
    ActiveChart.ChartTitle.Select
    With Selection.Font
        .Name = " arial "
        .Size = 11
    End With
   
    ActiveSheet.ChartObjects("Chart 2").Activate
  ActiveChart.ChartArea.Select

With ActiveSheet.ChartObjects("chart 2")
    .Top = Range("h17").Top
    .Left = Range("h17").Left
    .Height = Range("h17:h31").Height
    .Width = Range("h17:j31").Width
End With   
End Sub