Saving Selection Ranges on difrant sheets as One PDF

[mokhtar]

Hi everyone,

I have an excel file with 4 sheet
sheet1.range "A1" = "PRINTING"
sheet1.range "A5" = "MOKHTAR"
sheet1.range "D5" = 2015

sheet4.range "A1" = "PRINTING"

I'm trying to create a code to do this :

1- Select Worksheet.RANGE A1:F20 If Worksheet.Range("A1") = "PRINTING"
2- SAVE SELECTION RANGES AS ONE PDF FILE
PDF Name:="D:\" & Worksheets(1).Range("A5").Value & " " & Worksheets(1).Range(" D5 ").Value

Regards

[Kenneth Hobs]

In this case, there would be 2 PDF pages?

For your PDF name, you will need to concatenate ".pdf".

[mokhtar]

Thank you so much mr kenneth for the response
but there is a solution to create one pdf from selection ranges
I'll try this solution : copy selection ranges - add new sheet - paste - create one pdf from new sheet -delete new sheet
Could you help me to do this task please any suggestions are welcome
Thanks in advance for your help!!

[mokhtar]

HI mr kenneth
this is my solution to create one pdf from selection ranges on different sheets

Sub SaveAsPDFB2CON()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim fName As String
Dim i As Integer
Dim ws As Worksheet
fName = Worksheets(1).Range("A5").Value & " " & Worksheets(1).Range(" D5 ").Value

Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "RESULT"

For Each ws In ActiveWorkbook.Worksheets

If ws.Name <> "RESULT" Then
If ws.Range("A1") = "printing" Then ws.Activate
ActiveSheet.Range("A1:f20").Copy Destination:=Sheets("RESULT").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If

Next ws

Sheets("RESULT").Activate

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:="D:\" & fName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False


Sheets("RESULT").Select
ActiveWindow.SelectedSheets.Delete
Sheets("1").Select

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub



but the data in sheet RESULT repeated 2 times
how i prevent this repeat
sorry for my bad english.
Regards

[Kenneth Hobs]

Your English is better than my anything other than English.

You are close. I would do this for you if needed but you seem to nearly have it anyway. I would use a few of the concepts that I used in the recent link below. You will notice that one seldom needs Select or Activate.

http://www.vbaexpress.com/forum/showthread.php?52996-Saving-Excel-Selection-as-A-PDF-document

If you need me to add those concepts to yours, just let me know. You learn more by doing it yourself though. If you get it working, please post your final code.

[mokhtar]

mr kenneth you're really wonderful , Thanks for your time
the link is very useful , but I have tried several ways and get the same problem
Could you do this for me Just update my code to works exactly as i hoped
without any problem or repitition the data
Thanks in advance
mokhtar

[Kenneth Hobs]

I normally test code before posting but did not in this case. Try it out and if you can't see how to fix a problem, just post back. Always test code on a backup copy.

You will note that I used Debug.Print. This method can help you debug code when you view the output in the Immediate Window of the Visual Basic Editor (VBE).

Sub SaveAsPDFB2CON()
Dim fName As String, i As Integer, ws As Worksheet
Dim cWS As Worksheet, rWS As Worksheet

On Error GoTo EndSub
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set cWS = ActiveSheet


fName = "D:\" & Worksheets(1).Range("A5").Value2 & " " & Worksheets(1).Range("D5").Value2 & ".pdf"
Debug.Print fName, Len(Dir(fName)) <> 0

Set rWS = Worksheets.Add(After:=Sheets(Worksheets.Count))
rWS.Name = "RESULT"

For Each ws In Worksheets
With ws
If .Name <> "RESULT" Then
If LCase(.Range("A1").Value2) = "printing" Then _
.Range("A1:F20").Copy rWS.Range("A" & rWS.Rows.Count).End(xlUp).Offset(1)
End If
End With
Next ws

rWS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False

rWS.Delete
cWS.Activate

EndSub:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

[mokhtar]

Oh yeah

mr kenneth you're really fantastic
Thank you so much ... it works exactly as i hoped
Million Thanks