简体   繁体   中英

Copy sheet with excel vba

I am trying to copy one sheet from Workbook A to newly added Workbook B. The problem I have is that it does not keep the PageSetup. The new workbook with the copied sheet doesnt fit on one page as the original source does. I have tried to research this but cant determine if I need to copy all the attributes in the PageSetup or if it should just work when copying the whole sheet. This is my code so far:

     Public Sub makeCopies(ByVal seller As String)
        Dim thisWB As Workbook
        Dim newWB As Workbook
        Set thisWB = ActiveWorkbook

        Set newWB = Workbooks.Add
        On Error GoTo ErrorHandler:
        thisWB.Sheets(1).Copy Before:=newWB.Sheets(1)
        newWB.Activate

        newWB.SaveAs fileName:=seller & ".xlsx"
        newWB.Close
        thisWB.Activate
        Exit Sub

    ErrorHandler:
        MsgBox "Error" & Err.Number & Err.Description
        newWB.Close
    End Sub

It is a bit unclear as to exactly what Worksheet.PageSetup property or properties are not being carried across. In the following procedure, modified slightly so that orphaned, blank worksheets are not included in the new workbook, the '× wide by × tall' property as well as 'rows to repeat at top' were carried across to the new worksheet/workbook faithfully.

Sub main()
    makeCopies "makeCopies"
End Sub

Public Sub makeCopies(ByVal seller As String)
   Dim thisWB As Workbook
   Dim newWB As Workbook
   Set thisWB = ActiveWorkbook

   On Error GoTo ErrorHandler:
   thisWB.Sheets(1).Copy
   Set newWB = ActiveWorkbook

   newWB.SaveAs Filename:=Environ("TEMP") & Chr(92) & seller & ".xlsx"
   newWB.Close
   thisWB.Activate
   Exit Sub

ErrorHandler:
   MsgBox "Error" & Err.Number & Err.Description
   newWB.Close
End Sub

Copying a worksheet to 'no destination' creates a new workbook with that workbook holding the ActiveWorkbook property . The only worksheet will be a direct copy of the original which seems more desirable unless you need 1-3 blank worksheets in the new workbook for some reason.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM