Dim sh As Worksheet
Dim d As ChartObject
Dim s() As String
Dim x As Integer
Dim i As Integer
For Each sh In Sheets
For Each d In sh.ChartObjects
Set d = sh.ChartObjects(1)
ReDim Preserve s(x)
s(x) = sh.Name & ";" & d.Name
d.Chart.Location xlLocationAsNewSheet, sh.Name & ";" & d.Name
x = x + 1
Next d
Next sh
Sheets(s).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\temp\Mappe.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Sheets(1).Select
For i = Sheets.Count To 1 Step -1
If TypeName(Sheets(i)) = "Chart" Then
s = Split(Sheets(i).Name, ";")
Sheets(i).Location xlLocationAsObject, s(0)
End If
Next i