ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   How do I format a sheet using a copy macro? (https://www.excelbanter.com/excel-programming/357680-how-do-i-format-sheet-using-copy-macro.html)

Nimbus55

How do I format a sheet using a copy macro?
 
I am trying to save one sheet in a workbook as a separate file using the
following code, but I am having a couple of problems...a graphic object is
not being copied and the formating is not working...it's getting cut off
along the right side, although it prints perfectly in the context of the main
book.

Sub cmdSaveSignOff()
'------------------------------------------------------------------------------------
' Save the Score Sheet alone to another file
'------------------------------------------------------------------------------------

' Go to the score sheet
Sheets("Sign Off ").Select

' Confirm user really wants to do this
prompt = "This command will copy the Sign Off Sheet into a new Excel
file" _
+ " without any of the other sheets." _
+ vbCrLf + vbCrLf _
+ "Please note the following:" _
+ vbCrLf + vbCrLf _
+ "1/ The new file will contain only the text of the Sign Off
Sheet - no" _
+ " calculations/automation will be performed." _
+ vbCrLf _
+ "2/ Subsequent changes to this Sign Off Sheet will NOT be
automatically copied " _
+ "to the new file. You will have to save it again." _
+ vbCrLf + vbCrLf _
+ "Do you want to continue?"
Title = "Save Sign Off"
Buttons = vbYesNo + vbDefaultButton2 + vbQuestion
Confirm = MsgBox(prompt, Buttons, Title)
If Confirm = vbNo Then
MsgBox "Sign Off Not Saved!", vbExclamation, Title
Exit Sub
End If

' For speed, turn off automatic calculation and screen updating
Call subAutoCalculation(False)
Application.ScreenUpdating = False

' Grab the current workbook name for later
aWB = ActiveWorkbook.Name

' Copy the data
Cells.Select
Selection.Copy
Range("C3").Select ' put cursor back

' Create a new workbook
Workbooks.Add

' Paste the data as "values"
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

' Paste the formatting
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

' Copy the color palette
ActiveWorkbook.Colors = Workbooks(aWB).Colors

' Do proper page setup
Application.StatusBar = "Page setup..."
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.75)
.FooterMargin = Application.InchesToPoints(0.75)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperRegular
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = True
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 99
End With

' Reset selection
Range("C3").Select

' Save the file
Application.Dialogs(xlDialogSaveAs).Show
If ActiveWorkbook.Path = "" Then ' if the new workbook has no
path then
prompt = "Sign Off Sheet Not Saved!" ' the user cancelled out of
the "Save As" dialog
Else
NewFile = ActiveWorkbook.Path + "\" + ActiveWorkbook.Name
prompt = "Sign Off Sheet saved as " + NewFile
End If
MsgBox prompt, vbExclamation, Title ' display results

' Close the new file (without saving since we just saved it or the user
canceled out
' of the "Save As" dialog)
ActiveWorkbook.Close (False)

' Start updating the screen again
Application.ScreenUpdating = True

' Turn automatic calculation back on
Call subAutoCalculation(True)

End Sub








Bill Renaud[_2_]

How do I format a sheet using a copy macro?
 
As a quick suggestion, in this case, copy the entire worksheet to a new
workbook using the following basic procedure (turn on the macro recoder,
then edit the recorded code when done):

1. Open a new workbook.
2. Activate the original workbook.
3. Arrange the windows vertically side-by-side.
4. Hold down the Ctrl key, then drag the worksheet to be copied to the new
empty workbook.
5. Select all cells on the newly copied worksheet in the new workbook (click
on the blank area right above the first row number and left of the first
column label).
6. Copy data.
7. PasteSpecial Values. This will eliminate any links back to the source
workbook.
8. Delete any empty worksheets in the new workbook.
9. Save the workbook with a new name.

This way, all of the formatting, including page setups, will already be
included. Also, all objects (including any embedded charts) should also copy
.. Leave out the 30 or so lines of code to set the PageSetup properties
(LeftMargin, TopMargin, LeftHeader, etc.). The PageSetup properties have
always been slow in VBA (at least up to Excel 2000), and seem to take about
1 second for each one.

Also, I don't think you will need to turn Automatic Calculation off for this
macro, as it won't really save any measurable time.
--
Regards,
Bill




All times are GMT +1. The time now is 02:43 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com