No, the pictures don't really help. The best is a clear description of the problem. I think we're getting somewhere.
Something like this might be what you need. Put each chart onto its own worksheet with no data on the sheet.
Set pptApp = CreateObject("PowerPoint.Application")
Set pptPre = pptApp.Presentations.Add
' loop the sheets
For Each objSheet In ActiveWorkbook.Worksheets If WorksheetFunction.Count(objSheet.UsedRange) > 0 Then
' Data in sheet so copy used range
objSheet.UsedRange.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Else
' No data in sheet, so copy chart
objSheet.ChartObjects(1).Chart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
End If
'Create new slide for the data
Set pptSld = pptPre.Slides.Add(pptPre.Slides.Count + 1, ppLayoutBlank)
' paste the copied picture
pptSld.Shapes.Paste
Next