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

[Manchesterisred]

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]

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.

 

[Manchesterisred]

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]

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:

'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