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.
Any help would be highly appreciated. Thank you in advance.</space></space>
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