You are here:

Excel/Print and save as a new workbook on desired place

Advertisement


Question
QUESTION: HI Tom ! How r u ? I am using excel 2007 and in a work i m using the below code to print the selected range and its working fine...

Sub GPFEMPcodeprint_Click()
Dim r As Range, cell As Range
Set r = Range("AC2", Cells(Rows.Count, "AC").End(xlUp))
For Each cell In r
Range("B3").Value = cell
Range("C1:AA32").PrintOut
Next
End Sub

But i want some changes so that it can save my time and i know only you can help me...

i connected above code in a button and as i click it runs and print all the information that is in the range.

What i am expecting some more is..

1. As i click, first it ask me where to save the files. as i select the path to save the files.

2. It will copy the print area range and paste to a new workbook with all the borders and source theme but without any formula but with cell values only.

3. Save the workbook to the given path with the current cell value in cells D3, D4 and D5.

4. and then print as the above code is printing the sheet.

Hope its possible......

Waiting for a kind reply.

Thanks & Regards
Amit

ANSWER: Amit,

Sub GPFEMPcodeprint_Click()
Dim r As Range, cell As Range
Dim s As String, FldrPath As String
Dim s1 As String, r1 As Range
Dim sh As Worksheet, sh1 As Worksheet
Dim bk1 As Workbook
With Application.FileDialog(msoFileDialogFolderPicker)
 .Show
 If .SelectedItems.Count = 0 Then
   MsgBox "Nothing selected"
   Exit Sub
 End If
 FldrPath = .SelectedItems(1)
End With
s = Right(FldrPath, 1)
If s <> "\" Then FldrPath = FldrPath & "\"

Set sh = ActiveSheet
Set r1 = sh.Range("C1:AA32")
Set r = sh.Range("AC2", sh.Cells(Rows.Count, "AC").End(xlUp))
For Each cell In r
sh.Range("B3").Value = cell
s = sh.Range("D3").Text & sh.Range("D4").Text & sh.Range("D5").Text & ".xlsx"
s1 = FldrPath & s
Workbooks.Add Template:=xlWBATWorksheet
Set bk1 = ActiveWorkbook: Set sh1 = ActiveSheet
sh.Cells.Copy
sh1.Cells.PasteSpecial Paste:=xlFormats
r1.Copy
sh1.Range("C1").PasteSpecial Paste:=xlValues
bk1.SaveAs Filename:=s1, FileFormat:=xlOpenXMLWorkbook
sh1.Range(r1.Address).PrintOut
bk1.Close SaveChanges:=True
Set sh1 = Nothing
Set bk1 = Nothing

Next
End Sub

Code is untested but should get you started.

--
Regards,
Tom Ogilvy


---------- FOLLOW-UP ----------

error screen
error screen  
debug line
debug line  
QUESTION: Hi Tom ! I tested the provided code but it showing the error i attached the preview of the error and debug screen.

kindly take a look and help.

Thanks & Regards
Amit

ANSWER: Amit,

I made a routine to test the code you say is having problems.

Sub abcdeg()
Set sh = Worksheets("Sheet9")
Set sh1 = Worksheets("Sheet10")
Set r1 = sh.Range("C1:AA32")
r1.Formula = "=Trunc(rand()*100+1)"
sh.Cells.Copy
sh1.Cells.PasteSpecial Paste:=xlFormats
r1.Copy
sh1.Range("C1").PasteSpecial Paste:=xlValues
End Sub

that worked fine for me.

So that is all I can check and that worked fine for me.  You pictures are too small to read but again, I tested the commands as written and they worked fine.

--
Regards,
Tom Ogilvy



---------- FOLLOW-UP ----------

error screen
error screen  

debug line
debug line  
QUESTION: May Be but Dear Tom its showing error on my side so i am sending the images again so that i can show you the error

Answer
Amit,

read the error - you have merged cells in your source data.  It is well known that copying and pasting merged cells causes problems.  I suspect you can't do it manually. Remove the merged cells until you can perform the copy and paste manually.  Then the code should work.

--
Regards,
Tom Ogilvy

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

All Answers


Answers by Expert:


Ask Experts

Volunteer


Tom Ogilvy

Expertise

Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]

Experience

Extensive experience.

Education/Credentials
Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2016 About.com. All rights reserved.