copy and paste ws into new wb

[ysherriff]

I have the following code that is part of a long vba code, where it copies and paste two worksheets into new workbook. One of the sheet, I want to copy and paste special value and the other, I just want to copy as is. This is part of my code:

With Application
  .ScreenUpdating = False

  '  Copy specific sheets
  '  *SET THE SHEET NAMES TO COPY BELOW*
  '  Array("Sheet Name", "Another sheet name", "And Another"))
  '  Sheet names go inside quotes, seperated by commas
  Sheets(Array("PSR TEMPLATE CONTROL", "PSR CALCULATOR")).Copy
  On Error GoTo 0

  '  Paste sheets as values
  '  Remove External Links, Hperlinks and hard-code formulas
  '  Make sure A1 is selected on all sheets
  With ws("PSR TEMPLATE CONTROL")
  ws.Cells.Copy
  ws.[A1].PasteSpecial Paste:=xlValues
  ws.Cells.Hyperlinks.Delete
  Application.CutCopyMode = False
  ws.Protect Password:="ops"
  ws.Visible = xlSheetHidden
  End With

  With ws("PSR CALCULATOR")
  ws.Cells.Copy
  ws.Cells.Hyperlinks.Delete
  Application.CutCopyMode = False
  ws.Protect Password:="ops"
  ws.Visible = xlSheetHidden
  End With
  Cells(1, 1).Select

  .ScreenUpdating = True

  End With

For some reason getting an error message with the With the multiple statement. Is there a more efficient way of writing this code. Thanks for your help.

 

[Hui]

Try:

Application.ScreenUpdating = False

'  Copy specific sheets  
'  *SET THE SHEET NAMES TO COPY BELOW* 
'  Array("Sheet Name", "Another sheet name", "And Another"))  
'  Sheet names go inside quotes, seperated by commas  

Sheets(Array("PSR TEMPLATE CONTROL", "PSR CALCULATOR")).Copy
  On Error GoTo 0

'  Paste sheets as values  
'  Remove External Links, Hperlinks and hard-code formulas  
'  Make sure A1 is selected on all sheets 
With ws("PSR TEMPLATE CONTROL")
  ws.Cells.Copy
  ws.[A1].PasteSpecial Paste:=xlValues
  ws.Cells.Hyperlinks.Delete
  Application.CutCopyMode = False
  ws.Protect Password:="ops"
  ws.Visible = xlSheetHidden
  End With

  With ws("PSR CALCULATOR")
  ws.Cells.Copy
  ws.Cells.Hyperlinks.Delete
  Application.CutCopyMode = False
  ws.Protect Password:="ops"
  ws.Visible = xlSheetHidden
  End With
  Cells(1, 1).Select

Application.ScreenUpdating = True

 

[ysherriff]

Thanks Hui. I am getting an error message. I will try to do a workaround. I will let you know what i come up with.


Thanks

 

[ysherriff]

Hui,

I know this is not the most efficient way to do this code but I got it to work:

With Application
.ScreenUpdating = False

' Copy specific sheets
' *SET THE SHEET NAMES TO COPY BELOW*
' Array("Sheet Name", "Another sheet name", "And Another"))
' Sheet names go inside quotes, seperated by commas
Sheets(Array("PSR TEMPLATE CONTROL", "PSR CALCULATOR")).Copy
On Error GoTo 0

' Copy sheets
' Remove External Links, Hperlinks
' Make sure A1 is selected on all sheets
For Each ws In ActiveWorkbook.Worksheets
ws.Cells.Copy
ws.Cells.Hyperlinks.Delete
Application.CutCopyMode = False
Cells(1, 1).Select
ws.Activate
Next ws
Cells(1, 1).Select

.ScreenUpdating = True
End With
'activates PSR Template and copy and paste as values,password protect sheet and hide sheet
Worksheets("PSR TEMPLATE CONTROL").Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Protect Password:="ops", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.Visible = False

'activates PSR calculator template and reference PSR name and PSR Rev from template control sheet
Worksheets("PSR CALCULATOR").Activate
Range("C5").Select
ActiveCell.FormulaR1C1 = "=CELL_PSR_NAME"

Range("C11").Select
ActiveCell.FormulaR1C1 = "=CELL_PSR_REV"
ActiveSheet.Protect Password:="ops", DrawingObjects:=True, Contents:=True, Scenarios:=True

'protect the workbook
ActiveWorkbook.Protect Password:="ops", Structure:=True, Windows:=False