VBA to convert pdf

[Abdulkhadar]

Hi Excel Experts.
I want to save excel sheet as pdf, file name is as per cell C15, location -desktop.
Thank you

 

[jolivanes]

When I have some time, I'll look into changing it to filtering on Sheet Names.
If you keep the "Data" & "Centre" Sheets as the two leftmost Sheets. If that will not be the case, macro needs to be changed.

Sub With_Three_Loops()
Dim myDir As String
Dim c As Range
Dim i As Long, j As Long
myDir = "C:\Abduls_PDF_Files\"    '<---- Change as required
For i = 3 To ThisWorkbook.Worksheets.Count
    Sheets(i).UsedRange.Offset(18).ClearContents
Next i
With Sheets("Data")
    For Each c In .Range("F2:F" & .Cells(.Rows.Count, 6).End(xlUp).Row)
        If Not Sheets(c.Value) Is Nothing Then
            With Sheets(c.Value)
                .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Resize(, 4).Value = c.Offset(, -4).Resize(, 4).Value
            End With
        End If
    Next c
End With
    For j = 3 To ThisWorkbook.Worksheets.Count
        With Sheets(j)
            If Len(.Cells(15, 3)) > 0 Then
                .PageSetup.PrintArea = .Range("A1:E" & .Cells(.Rows.Count, 5).End(xlUp).Row).Address
                .ExportAsFixedFormat 0, myDir & .Cells(15, 3).Value & ".pdf"
            End If
        End With
    Next j
End Sub

 

[Abdulkhadar]

When I have some time, I'll look into changing it to filtering on Sheet Names.
If you keep the "Data" & "Centre" Sheets as the two leftmost Sheets. If that will not be the case, macro needs to be changed.

It works perfect. Thanks once again.

 

[Abdulkhadar]

When I have some time, I'll look into changing it to filtering on Sheet Names.
If you keep the "Data" & "Centre" Sheets as the two leftmost Sheets. If that will not be the case, macro needs to be changed.

sorry, forget to say, add Sl. No. to every sheet up to used column B cell before covert pdf. please add one more code to get Sl. No. to every sheet

 

[jolivanes]

Change this

If Not Sheets(c.Value) Is Nothing Then
            With Sheets(c.Value)
                .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Resize(, 4).Value = c.Offset(, -4).Resize(, 4).Value
            End With
        End If

to this

If Not Sheets(c.Value) Is Nothing Then
            With Sheets(c.Value)
                With .Cells(.Rows.Count, 2).End(xlUp).Offset(1)
                    .Resize(, 4).Value = c.Offset(, -4).Resize(, 4).Value
                    .Offset(, -1).Value = .Row - 18
                End With
            End With
        End If

Read the last line in Post #7 again.

 

[Abdulkhadar]

Change this

If Not Sheets(c.Value) Is Nothing Then
            With Sheets(c.Value)
                .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Resize(, 4).Value = c.Offset(, -4).Resize(, 4).Value
            End With
        End If

to this

If Not Sheets(c.Value) Is Nothing Then
            With Sheets(c.Value)
                With .Cells(.Rows.Count, 2).End(xlUp).Offset(1)
                    .Resize(, 4).Value = c.Offset(, -4).Resize(, 4).Value
                    .Offset(, -1).Value = .Row - 18
                End With
            End With
        End If

Read the last line in Post #7 again.

Thanks once again. I appreciate your patience.

 

[jolivanes]

Thanks for the update and good luck