copying to another workbook

[sedgely]

i want to achieve 2 things:
firstly to copy 2 sheets out of a workbook and into a new book but only the values and formats.
and secondly copy one of the sheets into an existing workbook again only values and formats.
i have got the first part working but am struggling with the second. the code i have up to now is below, probably not the best way to do it, but it does the job apart from the second bit (highlighted) can someone point me in the right direction?

Function Export()
'exports sheets into individual weekly workbooks

Application.ScreenUpdating = False

'declare and set variables*******************

   Dim wb As Workbook
   Dim sh
   Dim shNo As Integer
   Dim strNewFileName As String
   Dim objSheet As Worksheet
   Dim strMsg As String
   Dim msgStyle
   Dim msgTitle As String
   Dim response
   Dim mystring
   Dim strDate
   Dim intFileOverwrite As Integer
   Dim arrws(), i As Long
   Dim AnnualWB As Workbook
   Dim strSickSheetName As String
      
   Set objSheet = Sheets("parameters")
   strDate = objSheet.Range("b3").Value
   intFileOverwrite = 0
   shNo = 1
   strNewFileName = objSheet.Range("o3").Value
    msgStyle = vbYesNo + vbCritical + vbDefaultButton2
    msgTitle = "Confirm Save"
    strMsg = "A file already exists for week commencing " _
                & strDate _
                & ". Do you want to overwrite it?"
    
    'AnnualWB = objSheet.Range("o5").Value
    strSickSheetName = objSheet.Range("i3").Value
    
'check to see if file already exists************
   
If FileThere(strNewFileName) Then
    response = MsgBox(strMsg, msgStyle, msgTitle) ' set response variable to display message box
        'get user response
         If response = vbYes Then    ' User chose Yes.
            intFileOverwrite = 0
            
         Else    ' User chose No.
            intFileOverwrite = 1
         End If
Else
     
End If

'if file exists or user chose to overwrite then run code else end

If intFileOverwrite = 0 Then
  
   Application.DisplayAlerts = False
   Application.SheetsInNewWorkbook = 2
'create new workbook
'copy relevant sheets
'and paste values and formats ONLY

   Set wb = Workbooks.Add
   With wb
     For Each sh In Array("sickness", "abstractions")
       ThisWorkbook.Sheets(sh).Cells.Copy
       .Sheets(shNo).Cells.PasteSpecial Paste:=xlValues
       .Sheets(shNo).Cells.PasteSpecial Paste:=xlFormats
       .Sheets(shNo).Name = sh
       .Sheets(shNo).EnableSelection = xlUnlockedCells
       .Sheets(shNo).Protect Password:="pword", DrawingObjects:=True, Contents:=True, Scenarios:=True
       shNo = shNo + 1
     Next
   End With
       
   Application.CutCopyMode = False
   'Application.DisplayAlerts = false
   wb.SaveAs strNewFileName 'save the new workbook with the given name
   wb.Close 'close new workbook
[COLOR=red yellow]   
   shNo = 1
   Set AnnualWB = Workbooks.Open(objSheet.Range("o5").Value)
   With AnnualWB
   ThisWorkbook.Sheets("Sickness").Copy
        .Sheets(shNo).Cells.PasteSpecial Paste:=xlValues
        .Sheets(shNo).Cells.PasteSpecial Paste:=xlFormats
        .Sheets(shNo).Name = strSickSheetName
        .Sheets(shNo).EnableSelection = xlUnlockedCells
        .Sheets(shNo).Protect Password:="mrmann", DrawingObjects:=True, Contents:=True, Scenarios:=True
    End With
   
   AnnualWB.Save
   AnnualWB.Close
[/color]   
   Application.SheetsInNewWorkbook = 3 'reset number of sheets in new workbooks to default
Application.ScreenUpdating = True
Else
End
End If
End Function

Cheers, Craig
Si fractum non sit, noli id reficere

 

[SkipVought]

Hi,

If you are finally PROTECTING the sheet, maybe you FIRST need to UNPROTECT the sheet before performing any changes to the sheet.

Skip,
[sub]
[red][/red]
[/sub]

 

[sedgely]

Thought you were onto something there Skip, but i have removed all the protection and am still getting an error:
PasteSpecial method of Range class Failed

 Application.CutCopyMode = False
   'Application.DisplayAlerts = false
   wb.SaveAs strNewFileName 'save the new workbook with the given name
   wb.Close 'close new workbook
   
   shNo = 1
   Set AnnualWB = Workbooks.Open(objSheet.Range("o5").Value)
   With AnnualWB
   ThisWorkbook.Sheets("Sickness").Copy
        [COLOR=red yellow].Sheets(shNo).Cells.PasteSpecial Paste:=xlValues[/color]
        .Sheets(shNo).Cells.PasteSpecial Paste:=xlFormats
        .Sheets(shNo).Name = strSickSheetName
        .Sheets(shNo).EnableSelection = xlUnlockedCells
        DrawingObjects:=True, Contents:=True, Scenarios:=True
    End With
   
   AnnualWB.Save
   AnnualWB.Close

Cheers, Craig
Si fractum non sit, noli id reficere

 

[SkipVought]

rather than Cells as the range, use A1...

.Sheets(shNo).[A1].PasteSpecial Paste:=xlValues

Skip,
[sub]
[red][/red]
[/sub]

 

[PHV]

ThisWorkbook.Sheets("Sickness").Copy
This creates a new workbook with a single sheet.
You wanted perhaps this ?
ThisWorkbook.Sheets("Sickness")[!].Cells[/!].Copy

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[sedgely]

Thanks to you both, it is now sorted. PH you solution did it.

Cheers, Craig
Si fractum non sit, noli id reficere