Copy Selected range to a new workbook

[rjdeyoe]

Hi again.
I have a code that will allow me to copy three worksheets from an open workbook to a new workbook. That works great, but I only need only a selected range from each of these worksheets to be copied (Range A1:AV60). Here is the code I use to select and copy the worksheets, how do I add a range within this code for each worksheet.
Sheets(Array("Req Page 1", "Req Ext 1", "Req Ext 2")).Copy

 

[Von Pookie]

Would this work for you?

Dim wbNew As Workbook, sh As Worksheet

Set wbNew = Workbooks.Add
For Each sh In ThisWorkbook.Sheets(Array("Req Page 1", "Req Ext 1", "Req Ext 2"))
    With wbNew
        .Worksheets.Add before:=wbNew.Sheets(1)
        .Sheets(1).Name = sh.Name
        sh.Range("A1:AV60").Copy .Sheets(1).Range("A1")
    End With
Next sh

 

[rjdeyoe]

Thanks, i will see what it does. Looks promising.

 

[rjdeyoe]

I attempted to insert the code into my orginal code and errors were all over the place. So after scratching my head for a few hours, thought i would send my orginal code to you to see what i should do. Code need to
unprotect worksheets before copy (found that i could not copy a protected sheet, unless i am missing something). Copy the three sheets, without any control buttons or links (why i asked for the range), and protect the worksheets upon completion. Appreaciate any help. Below is my code:

Sub CopyRequsitionsToNewWorkSheet()
    Dim NewName As String
    Dim nm As Name
    Dim ws As Worksheet
    Dim ct As Worksheet
    Dim st As Worksheet
     
    If MsgBox("Copy Requistion sheets to a new workbook" & vbCr & _
    "Requistion will be copied unprotected, Sheets named the same" _
    , vbYesNo, "NewCopy") = vbNo Then Exit Sub
     
    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
                 
        On Error GoTo ErrCatcher
        Sheets(Array("Req Page 1", "Requistion Extension 1", "Requistion Extension 2")).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
         
         For Each ct In ActiveWorkbook.Worksheets
            ct.Unprotect
           
        Next ct
         
        For Each ws In ActiveWorkbook.Worksheets
            ws.Cells.Copy
            ws.[A1].PasteSpecial Paste:=xlValues
            ws.Cells.Hyperlinks.Delete
            Application.CutCopyMode = False
            Cells(1, 1).Select
            ws.Activate
            ws.Unprotect
            
        Next ws
        Cells(1, 1).Select
         
         '       Remove named ranges
        For Each nm In ActiveWorkbook.Names
            nm.Delete
        Next nm
         
         '       Input box to name new file
        NewName = InputBox("Please Specify the name for the new Requistion", "New Copy")
         
         '       Save it with the NewName and in the same directory as original
        ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls"
        ActiveWorkbook.Protect
        ActiveWorkbook.Close SaveChanges:=False
         
        .ScreenUpdating = True
        
    End With
        
   For Each st In ActiveWorkbook.Worksheets
            st.Protect
       
    Next st
    
    Exit Sub
     
ErrCatcher:
    MsgBox "Specified sheets do not exist within this workbook"
        
End Sub

 

[Von Pookie]

Would this work?

Sub CopyRequsitionsToNewWorkSheet()
Dim NewName As String, nm As Name, wbNew As Workbook
Dim Sh As Worksheet

If MsgBox("Copy Requistion sheets to a new workbook" & vbCr & _
"Requistion will be copied unprotected, Sheets named the same" _
, vbYesNo, "NewCopy") = vbNo Then Exit Sub

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

Set wbNew = Workbooks.Add
On Error GoTo ErrCatcher
For Each Sh In ThisWorkbook.Sheets(Array("Req Page 1", "Req Ext 1", "Req Ext 2"))
    With wbNew
        .Worksheets.Add before:=wbNew.Sheets(1)
        .Sheets(1).Name = Sh.Name
    End With
    With Sh
        .Unprotect
        .Range("A1:AV60").Copy wbNew.Sheets(1).Range("A1")
        .Protect
    End With
Next Sh
On Error GoTo 0

'Paste sheets as values
'Remove External Links, Hperlinks and hard-code formulas
'Make sure A1 is selected on all sheets

For Each Sh In wbNew.Worksheets
    With Sh
        .Unprotect
        .Cells.Copy
        .[A1].PasteSpecial Paste:=xlValues
        .Cells.Hyperlinks.Delete
        Application.Goto .Cells(1, 1)
        .Protect
    End With
Next Sh
Cells(1, 1).Select

'Remove named ranges
For Each nm In wbNew.Names
    nm.Delete
Next nm

'Input box to name new file
NewName = InputBox("Please Specify the name for the new Requistion", "New Copy")

'Save it with the NewName and in the same directory as original
With wbNew
    .SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls"
    .Protect
    .Close SaveChanges:=False
End With

Application.ScreenUpdating = True
Exit Sub

ErrCatcher:
MsgBox "Specified sheets do not exist within this workbook"

End Sub

You may also run into issues with your Inputbox as you have things right now--if the user leaves it blank, or enters something that can't be used as a legal filename, the code will throw an error.

 

[rjdeyoe]

Thanks for the assist. Only one thing that maybe an easy fix for you. When i run the code, it goes right to the ErrCatcher:

MsgBox "Specified sheets do not exist within this workbook"

When i run the debug, (step into), it will get to this line in the code and give me the message. I do get three new sheets on a new workbook, but they are blank and are not named. It skips the input name line asking for the file name. thanks


For Each Sh In ThisWorkbook.Sheets(Array("Req Page 1", "Req Ext 1", "Req Ext 2"))
With wbNew

 

[Von Pookie]

Strange. That bit seems to work for me with no problems. Are you certain the sheet names in the array are correct?

 

[rjdeyoe]

Hi, I am sorry i spoke too soon. Yes, it does copy. However the new workbook now contains, three extra pages, plus the orginal worksheets. Also, the page layout is way off. The orginal workbook (which i use as a template) is copied, to a new workbook. If it helps, would you like to to attach my workbook. it is not 100% but i am working on it.

 

[Von Pookie]

You can always delete the sheets you don't need, and have the macro set the page layout(s).

As far as I know, there is no way to copy the sheet entire sheet with only a certain range being copied. I suppose you could copy the entire sheet as before (to keep the layout/formatting) and just delete everything you don't need...

 

[rjdeyoe]

Thanks for all the help. With the info you gave me, i came up with a solution that will work. Again, thanks.