Copy worksheet in PDF and also Excel xlxs in to same folder.

Manchesterisred

New Member
Joined
Aug 20, 2021
Messages
17
Office Version
  1. 365
Platform
  1. Windows
Hi There, Can anyone help me with this ?

I currently have this macro which copies the excel worksheet in to their individual folder in PDF format under 1 master folder.

At the same time of copying the PDF, i also need it to make an save a copy of the same worksheet but in xlxs format into the same folder - Can anyone suggest how this should be written ?

One final thing - i need the PDF and the excel file to both also pick up cell "E20" [ at the moment it only picks up cell "B22" to make the title

Any help would be greatly appreciated


Sub DDPDF()
'
' Direct debit Letters convert excel to PDF and save to drive
'
Dim Sourcewb As Workbook
Dim WS As Worksheet
Dim DateString As String
Dim FolderName As String, Path As String, FName As String
Dim CellData As String

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationAutomatic
End With

'Copy every sheet from the workbook with this macro
Set Sourcewb = ThisWorkbook

'Create new MASTER folder to save the new files in
DateString = Format(Now, "yyyy-mm-dd")
FolderName = Sourcewb.Path & "\" & Format(Sourcewb.Worksheets("DD").Range("C38"), "0") & " - Direct Debit Letters - " & Format(Sourcewb.Worksheets("DD").Range("D38"), "dd.mm.yyyy") & " dated " & Format(Sourcewb.Worksheets("DD").Range("C32"), "dd.mm.yyyy")
MkDir FolderName

'Loop through all worksheets and save as individual PDF in same folder as the Excel file
For Each WS In ActiveWorkbook.Worksheets
Select Case WS.Name
Case "Instructions", "DDsap", "DD", "DDclean", "Company", "EUR", "GBP", "USD" 'This is the worksheet ignore list. Edit as needed
Case Else
CellData = Trim(CStr(WS.Range("B22").Value)) 'Cell data to use in names. Must not contain illegal chars.

'Create new INDIVIDUAL file folder to save the new file in
Path = FolderName & "\" & WS.Name & " - " & CellData
MkDir Path

FName = Path & "\" & WS.Name & " - " & CellData & ".pdf"

WS.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FName
End Select
Next WS

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,916
Office Version
  1. 2007
Platform
  1. Windows
Was any file created?
If it failed in one of the sheets, I need you to check what data you have in cells B22 and E20, it is likely that the data you have in one of those two cells has illegal characters to name a file.
 

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

Manchesterisred

New Member
Joined
Aug 20, 2021
Messages
17
Office Version
  1. 365
Platform
  1. Windows
Was any file created?
If it failed in one of the sheets, I need you to check what data you have in cells B22 and E20, it is likely that the data you have in one of those two cells has illegal characters to name a file.
HI Dante, In Cell B20 and E20 is the date in the 01/01/2021 format, hence the probable reason for the illegal character. I need to enter the date like that on the spreadsheet in that format.


In the beginning of the macro we have the same thing to create the master folder looking at cell C32 which also the date in that same format ,

'Create new MASTER folder to save the new files in
DateString = Format(Now, "yyyy-mm-dd")
FolderName = Sourcewb.Path & "\" & Format(Sourcewb.Worksheets("DD").Range("C38"), "0") & " - Direct Debit Letters - " & Format(Sourcewb.Worksheets("DD").Range("D38"), "dd.mm.yyyy") & " dated " & Format(Sourcewb.Worksheets("DD").Range("C32"), "dd.mm.yyyy")
MkDir FolderName


How can i get it to change your macro below here to do the same ?

add this lines:
WS.Copy
ActiveWorkbook.SaveAs Sourcewb.Path & "\" & WS.Range("B22").Value & WS.Range("E20").Value & ".xlsx"
ActiveWorkbook.Close False
'end add lines
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
13,916
Office Version
  1. 2007
Platform
  1. Windows
At the time of execution, what values do you have in the cells: "B22" and "E20"
I asked that from post # 4.

You cannot save a file with the forward slash "/".

Use the following:

VBA Code:
'add this lines:
      WS.Copy
      ActiveWorkbook.SaveAs Sourcewb.Path & "\" & format(WS.Range("B22").Value, "dd.mm.yyyy") & " " & format(WS.Range("E20").Value, "dd.mm.yyyy") & ".xlsx"
      ActiveWorkbook.Close False
'end add lines
 

Forum statistics

Threads
1,147,632
Messages
5,742,233
Members
423,715
Latest member
Albert Kuni

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top