Macro to convert a specific

Hello everyone,

I am looking at converting a specific sheet from multiple files in a pdf format. I have found a macro wich I have slightly modified to be able to select the input folder containing the original files and the output folder where the pdf files should go. Currently it is working fine but the whole worksheet in being printed to a pdf file. I would need to only print the spreadsheet named "Profil". The code is described here below.

Is there any one who could help me in modifying the existing macro to only convert the spreadsheet "Profil" to pdf?

In advance thank you very much

Option Explicit
Sub ExcelToPDF2()
Dim FilesInPath As String
Dim OutputPath2 As String
Dim MyFiles() As String, Fnum As Long
Dim Buk As Workbook, BukName As String
Dim CalcMode As Long
Dim sh As Worksheet
Dim StartTime As Date, EndTime As Date
Dim LPosition As Integer
Dim SourcePATH As String
Dim OuputPATH As String

'Specify the path of a folder where all the excel files are stored

StartTime = Timer

' select source path

MsgBox "Select the source Folder"
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count > 0 Then
        SourcePATH = .SelectedItems(1) & "\"
    Else
        Exit Sub
    End If
End With
' end select source path

' select output path

MsgBox "Select the output Folder"
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Show
    If .SelectedItems.Count > 0 Then
        OuputPATH = .SelectedItems(1) & "\"
    Else
        Exit Sub
    End If
End With


FilesInPath = Dir(SourcePATH & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set Buk = Nothing
On Error Resume Next
Set Buk = Workbooks.Open(SourcePATH & MyFiles(Fnum))
On Error GoTo 0

If Not Buk Is Nothing Then


LPosition = InStr(1, Buk.Name, ".") - 1
BukName = Left(Buk.Name, LPosition)
Buk.Activate

OutputPath2 = OuputPATH & BukName & ".pdf"

On Error Resume Next
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=OutputPath2, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False

    On Error GoTo 0
    
End If

Buk.Close SaveChanges:=False

Next Fnum
End If


With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With

EndTime = Timer
MsgBox "Task succesfully completed in " & Format(EndTime - StartTime, "0.00") & " seconds"

End Sub

Hi Nathansav

Sorry I have just tried but it does not seem to export the pdf files. Is it possible to define a range withing the "profil" sheet? I guess that your code identifies the file name and not the sheet within the worksheet. Or more probably I am totally out.

Hi Nathansav

Sorry I am relatively new to VBA, could you show me on the macro where I should insert the code you specified?

Thank you