PDA

View Full Version : my code is working.... almost



spacezaap
03-22-2018, 01:35 PM
Can you please tell me what is wrong with below code? It does what it's supposed to except naming the pdf file properly.
Bolded line seems to be the problem. Files are saved but each with the worksheet name instead of what is the the cell D2.
Thanks in advance for your input...
Tom

Sub mak()

Do Until (Range("A2") = "")
Sheets("Arkusz1").Range("A2").Copy
Sheets("Arkusz2").Activate
Range("D17").Select
ActiveSheet.Paste

Sheets("Arkusz1").Range("C2").Copy
Sheets("Arkusz2").Activate
Range("D14").Select
ActiveSheet.Paste

Sheets("Arkusz1").Range("E2").Copy
Sheets("Arkusz2").Activate
Range("D20").Select
ActiveSheet.Paste

Sheets("Arkusz1").Range("K2").Copy
Sheets("Arkusz2").Activate
Range("D6").Select
ActiveSheet.Paste

ActiveSheet.ExportAsFixedFormat Filename:=Range("D2").Value, Type:=xlTypePDF


Sheets("Arkusz1").Activate
Rows(2).EntireRow.Delete

Loop
End Sub

SamT
03-22-2018, 02:49 PM
I cleaned out all the extraneous junk the Macro recorder puts in. Otherwise this is the same Sub Procedure

Sub mak_Refactored()
Dim Usz2 As WorkSheet
Set Usz2 = Sheets("Arkusz2")

With Sheets("Arkusz1")
Do Until.Range("A2") = "" '???
Usz2.Range("D17") = .Range("A2")
Usz2.Range("D14") = .Range("C2")
Usz2.Range("D20") = .Range("E2")
Usz2.Range("D6") = .Range("K2")
Usz2.ExportAsFixedFormat Filename:=.Range("D2").Value, Type:=xlTypePDF
.Rows(2).EntireRow.Delete
Loop
End With
End Sub


So I searched for "ExportAsFixedFormat" with duckduckgo. It applies to workbooks, not worksheets.


Sub mak_Modified()
'For help, see: www.vbaexpress.com/forum/showthread.php?62328
Dim Usz2 As WorkSheet
Set Usz2 = Sheets("Arkusz2")

With Sheets("Arkusz1")
Do Until.Range("A2") = "" '???
Usz2.Range("D17") = .Range("A2")
Usz2.Range("D14") = .Range("C2")
Usz2.Range("D20") = .Range("E2")
Usz2.Range("D6") = .Range("K2")

Usz2.Copy 'Creates and activates a new Workbook with Sheet Arkusz2 in it.
With ActiveWorkbook 'The new workbook
.ExportAsFixedFormat Filename:=Sheets("Arkusz1").Range("D2").Value, Type:=xlTypePDF
.Saved = True 'Don't save it when closing it
.Close
End With

.Rows(2).EntireRow.Delete
Loop
End With
End Sub