Como guardar archivo en excel y PDF

Sub Crear_Archivos()
'
  Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
  Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
  Dim i As Long, j As Long, lr As Long
  Dim ruta As String, fact As String, rutafin As String
  '
  'nombres de los 2 libros. LOS 2 LIBROS DEBEN ESTAR ABIERTOS
  Set wb1 = Workbooks("Glosas.xlsx")
  Set wb2 = Workbooks("Respuesta.xlsx")
  Set sh1 = wb1.Sheets("ReporteGlosasReclamPJ")
  Set sh2 = wb2.Sheets("RTAGLOSA")
  '
  ruta = " C:\Nueva carpeta\"
  '
  '
  If Dir(ruta, vbDirectory) = "" Then
    MsgBox "No existe la carpeta :" & ruta
    Exit Sub
  End If
  '
  lr = sh1.Range("A" & Rows.Count).End(3).Row
  If lr = 1 Then Exit Sub
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  '
  fact = sh1.Range("A" & 2).Value
  Call Libro_Ruta(sh2, wb3, sh3, ruta, fact)
  '
  j = 15
  For i = 2 To lr + 1
    If fact <> sh1.Range("A" & i).Value Then
     wb3.SaveAs rutafin & "\" & "RTA_" & fact
          wb3.Close False
      If sh1.Range("A" & i).Value = "" Then Exit For
      Call Libro_Ruta(sh2, wb3, sh3, ruta, sh1.Range("A" & i).Value)
      j = 16
    Else
      j = j + 1
    End If
    sh3.Range("B11").Value = sh1.Range("A" & i).Value
    sh3.Range("B12").Value = sh1.Range("B" & i).Value
    sh3.Range("B13").Value = sh1.Range("C" & i).Value
    '
    sh3.Range("A" & j).Value = sh1.Range("D" & i).Value
    sh3.Range("B" & j).Value = sh1.Range("E" & i).Value
    sh3.Range("C" & j).Value = sh1.Range("F" & i).Value
    sh3.Range("D" & j).Value = sh1.Range("G" & i).Value
    '
    fact = sh1.Range("A" & i).Value
    rutafin = ruta & fact
sh3.Range("A" & j).Borders.LineStyle = xlContinuous
sh3.Range("B" & j).Borders.LineStyle = xlContinuous
sh3.Range("C" & j).Borders.LineStyle = xlContinuous
sh3.Range("D" & j).Borders.LineStyle = xlContinuous
sh3.Range("E" & j).Borders.LineStyle = xlContinuous
sh3.Range("F" & j).Borders.LineStyle = xlContinuous
sh3.Range("G" & j).Borders.LineStyle = xlContinuous
  Next
  '
  Application.ScreenUpdating = True
  MsgBox "Archivos Generados"
End Sub
'
Sub Libro_Ruta(sh2 As Worksheet, wb3 As Workbook, sh3 As Worksheet, ruta As String, fact As String)
  Dim rutafin As String
  sh2.Copy
  Set wb3 = ActiveWorkbook
  Set sh3 = wb3.Sheets(1)
  rutafin = ruta & fact
  If Dir(rutafin, vbDirectory) = "" Then MkDir rutafin
End Sub

Tengo una macro que me crea unas carpetas y dentro de ellas archivos en excel pero debo tambien guardar esos archivos en PDF. Me podrian ayudar a complementar la macro.