Копирование и вставка диаграммы по умолчанию как изображения в разных местах на одном листе

Question

Заранее спасибо за любую помощь с этим.

Чтобы поместить вещи в контекст, электронная таблица в целом фильтрует несколько сводных таблиц по «имени менеджера», и это обновляет некоторые данные, которые обновляют диаграмму на пяти различных листах. Эта диаграмма затем копируется и вставляется в виде изображения в, в настоящее время, в определенную ячейку на каждом листе, и процесс переходит к новому имени менеджера до завершения.

Единственная проблема, с которой я столкнулся, заключается в том, что все вставленные изображения (диаграммы) слегка перекрываются (слегка смещаясь вниз и вправо для каждой итерации), учитывая, что все они вставлены в одну и ту же ячейку (T2).

Я пробовал несколько способов решить эту проблему, но безрезультатно.

Мне бы хотелось, чтобы каждый график, длина которого составляла около 8 ячеек, был вставлен на 8/9 ячеек ниже последней вставки. Итак, вставка диаграммы 1 - ячейка T1, вставка диаграммы 2 - T8, вставка диаграммы 3 - T16.

В идеале я хотел бы вставить 10 диаграмм вниз, а затем переключиться на пару ячеек, например. W1 и еще 10, потом до Z1 и т. Д.

У меня было несколько ударов по счетам и смещениям

Sub RunReport()
Application.AskToUpdateLinks = False
Dim rng As Range, cell As Range
Dim pt As PivotTable
Dim firstname As Variant

Set rng = Range("Manager_list")
Set chge = Range("chartmove")

For Each cell In rng


If cell.Value = "#N/A" Then

GoTo 10

End If

'select manager

manager_select = cell.Value

firstname = Split(cell.Value, " ")(0)


'filter all pivots for IM

Set pt = Sheets("pivots").PivotTables("PivotTable1")
pt.PivotFields("IM").ClearAllFilters
pt.PivotFields("IM").CurrentPage = cell.Value

Dim pt2 As PivotTable
Set pt2 = Sheets("pivots").PivotTables("PivotTable2")
pt2.PivotFields("IM").ClearAllFilters
pt2.PivotFields("IM").CurrentPage = cell.Value

Dim pt3 As PivotTable
Set pt3 = Sheets("pivots").PivotTables("PivotTable3")
pt3.PivotFields("IM").ClearAllFilters
pt3.PivotFields("IM").CurrentPage = cell.Value

Dim pt4 As PivotTable
Set pt4 = Sheets("pivots").PivotTables("PivotTable4")
pt4.PivotFields("IM").ClearAllFilters
pt4.PivotFields("IM").CurrentPage = cell.Value

Dim pt5 As PivotTable
Set pt5 = Sheets("pivots").PivotTables("PivotTable5")
pt5.PivotFields("IM").ClearAllFilters
pt5.PivotFields("IM").CurrentPage = cell.Value

Dim pt8 As PivotTable
Set pt8 = Sheets("pivots").PivotTables("PivotTable8")
pt8.PivotFields("IM").ClearAllFilters
pt8.PivotFields("IM").CurrentPage = cell.Value

Dim pt14 As PivotTable
Set pt14 = Sheets("pivots").PivotTables("PivotTable14")
pt14.PivotFields("IM").ClearAllFilters
pt14.PivotFields("IM").CurrentPage = cell.Value

Dim pt13 As PivotTable
Set pt13 = Sheets("pivots").PivotTables("PivotTable13")
pt13.PivotFields("IM").ClearAllFilters
pt13.PivotFields("IM").CurrentPage = cell.Value

Dim pt15 As PivotTable
Set pt15 = Sheets("pivots").PivotTables("PivotTable15")
pt15.PivotFields("IM").ClearAllFilters
pt15.PivotFields("IM").CurrentPage = cell.Value

Dim pt16 As PivotTable
Set pt16 = Sheets("pivots").PivotTables("PivotTable16")
pt16.PivotFields("IM").ClearAllFilters
pt16.PivotFields("IM").CurrentPage = cell.Value

'cope and paste values into static sheet

   Sheets("pivots").Select
    Cells.Select
    Selection.Copy
    Sheets("pivots static").Select
    Cells.Select
    Range("U1").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("Z11").Select


'refresh data

  Application.Calculate

  'copy and paste chart for each IM/risk profile

  Sheets("L").Select
    ActiveSheet.ChartObjects("Chart 2").Activate
    ActiveChart.ChartArea.Copy
    Range("T" & X).Select
    ActiveSheet.Pictures.Paste.Select
  Sheets("LM").Select
      ActiveSheet.ChartObjects("Chart 2").Activate
    ActiveChart.PlotArea.Select
    ActiveChart.ChartArea.Copy
    Range("T2").Select
    ActiveSheet.Pictures.Paste.Select
  Sheets("M").Select
      ActiveSheet.ChartObjects("Chart 2").Activate
    ActiveChart.PlotArea.Select
    ActiveChart.ChartArea.Copy
    Range("T2").Select
    ActiveSheet.Pictures.Paste.Select
  Sheets("MH").Select
      ActiveSheet.ChartObjects("Chart 2").Activate
    ActiveChart.PlotArea.Select
    ActiveChart.ChartArea.Copy
    Range("T2").Select
    ActiveSheet.Pictures.Paste.Select
  Sheets("H").Select
      ActiveSheet.ChartObjects("Chart 2").Activate
    ActiveChart.PlotArea.Select
    ActiveChart.ChartArea.Copy
    Range("T2").Select
    ActiveSheet.Pictures.Paste.Select



Application.DisplayAlerts = True

Application.DisplayAlerts = False

'ActiveWorkbook.Close


'loop

10 Next cell



End Sub

Я бы хотел, чтобы каждая диаграмма длиной около 8 ячеек вставлялась на 8/9 ячеек ниже последней вставки. Итак, вставка диаграммы 1 - ячейка T1, вставка диаграммы 2 - T8, вставка диаграммы 3 - T16.

В идеале я хотел бы вставить 10 диаграмм вниз, а затем переключиться на пару ячеек, например. W1 и еще 10, потом до Z1 и т. Д.