Add copy charts and shapes with the present script for copy tabs of workbook to new workbook

[Malhotra Rahul]

Hi I am using the below script for copying specific worksheets from a workbook. I want to add for copy multiple Charts and Shapes as picture. Charts as Chart No. 71, 24 & 35 and Shape as Rectangle 53, 54 & 54.

Option ExplicitSub RunMacro1_Click()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim NewName As String, s As String, wb As Workbook, ws As Worksheet, i As Integer, X
    
    s = "Report & Product Analysis & Customer Analysis"  '//EDIT OR ADD SHEETS TO BE COPIED HERE (INCLUDE '<space>&<space>' BETWEEN NAMES)
    X = Split(s, " & ")
    
    If MsgBox("Sheets:" & vbCr & vbCr & s & vbCr & vbCr & "will be copied to a new workbook" & vbCr & vbCr & _
    "The sheets will be values only (named ranges, formulas and links removed)" & vbCr & vbCr & _
    "Do you want to continue?", vbYesNo, "Create New Workbook") = vbNo Then Exit Sub
    
    NewName = InputBox("Please Enter the name for the new workbook", "New Workbook Name")


    Application.ScreenUpdating = False
    Workbooks.Add
    Set wb = ActiveWorkbook
    With wb
        For i = 0 To UBound(X)
            Set ws = ThisWorkbook.Sheets(X(i))
            ws.Cells.Copy
            .Sheets.Add after:=Sheets(Sheets.Count): .ActiveSheet.Name = X(i)
            With .Sheets(X(i))
                .Cells.SpecialCells (xlCellTypeVisible)
                .[A1].PasteSpecial Paste:=xlValues
                .Cells.PasteSpecial Paste:=xlFormats
                .Cells.Hyperlinks.Delete
                
                Application.Goto .[A1]
            End With
        Next
        Worksheets("Variance").Visible = True
        Worksheets("Variance").Activate
        ActiveWindow.DisplayGridlines = False
        ActiveWindow.DisplayHeadings = False
        Application.DisplayFullScreen = True
        Application.DisplayAlerts = False
        For i = 1 To 1
            .Sheets("Sheet" & i).Delete
                
        .Colors = ThisWorkbook.Colors
                
        .SaveAs (NewName & ".xls")
       Next i
       End With
      
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Any help would be highly appreciated. Thank you in advance.</space></space>

 

[Malhotra Rahul]

Hi, May i expect the upgraded script. Charts as Chart No. 71 & Shape 53 is located in worksheet "Report" , Chart 24 and Shape 54 is located in worksheet Product Analysis, & Chart 35 and Shape 54 is located in worksheet Customer Analysis.

Please help me

 

[Malhotra Rahul]

Can anyone please help me.

 

[Malhotra Rahul]

May i expect to look into my thread and help me. Thank you in advance for your support. Any help would be highly appreciated.

 

[Malhotra Rahul]

So is there no way to copy the charts and objects to be added and paste them as picture with the provided script.

 

[Malhotra Rahul]

Can anyone please help me on my thread. I am struggling badly with this. Please

 

[Malhotra Rahul]

Can any one help me on the raised thread.