One effective way to present charts is to array them on a worksheet. You can lay them out manually, and even line them up nicely: by holding ALT while dragging and resizing charts, you constrain them to stick to the grid of cell boundaries.
However, if you have a lot of charts, this is tedious. I’ve arranged the charts in the view below using a VBA procedure.
The VBA procedure is not very complicated, and it lets you specify the height and width of each chart in cell units, as well as the top left cell under the first chart, and the number of rows and columns between adjacent charts.
Sub MakeGridOfCharts()
' Jon Peltier (3/19/2008, mod 10/03/2014)
' https://peltiertech.com/
' chart size - adjust as desired
' set one or both to zero to use dimensions of active chart
' (or first chart if no chart is active)
Const nRowsTall As Long = 6
Const nColsWide As Long = 3
' chart layout - adjust as desired
Const nChartsPerRow As Long = 3
Const nSkipRows As Long = 2
Const nSkipCols As Long = 1
Const nFirstRow As Long = 3
Const nFirstCol As Long = 2
Dim iChart As Long
Dim chtob As ChartObject
Dim dWidth As Double
Dim dHeight As Double
Dim rData As Range
Dim dFirstChartTop As Double
Dim dFirstChartLeft As Double
Dim dRowsBetweenChart As Double
Dim dColsBetweenChart As Double
If ActiveSheet.ChartObjects.Count > 0 Then
With ActiveSheet.Cells(nFirstRow, nFirstCol)
If nRowsTall * nColsWide > 0 Then
dWidth = nColsWide * .Width
dHeight = nRowsTall * .Height
Else
If Not ActiveChart Is Nothing Then
Set chtob = ActiveChart.Parent
Else
Set chtob = ActiveSheet.ChartObjects(1)
End If
dWidth = chtob.Width
dHeight = chtob.Height
End If
dFirstChartLeft = .Left
dFirstChartTop = .Top
dRowsBetweenChart = nSkipRows * .Height
dColsBetweenChart = nSkipCols * .Width
End With
For iChart = 1 To ActiveSheet.ChartObjects.Count
Set chtob = ActiveSheet.ChartObjects(iChart)
With chtob
.Left = ((iChart - 1) Mod nChartsPerRow) * _
(dWidth + dColsBetweenChart) + dFirstChartLeft
.Top = Int((iChart - 1) / nChartsPerRow) * _
(dHeight + dRowsBetweenChart) + dFirstChartTop
.Width = dWidth
.Height = dHeight
End With
Next
End If
End Sub