Imprimir rangos de varias hojas en pdf
Resulta que tengo 60 hojas en mi libro, las cuales tienen unos formularios que deseo imprimir en pdf, y ademas que me guarde todos los pdf en una ubicación con el nombre de una celda en cada hoja, bueno hasta ahi lo he logrado si lo hago uno por uno, pero no lo he logrado automatizar para que realice tal procedimiento para todas las hojas, mil gracias por su colaboración, el código que estoy utilizando es el siguiente:
Sub test()
Dim sh As Worksheet, contá As Long
contá = 1
Windows.Application.ScreenUpdating = False
For Each sh In ThisWorkbook.Sheets
RutaArchivo = "C:\Area_Calidad\Indicadores\Fichaspdf\" + Range("D6") + ".pdf"
Range("A1:E25").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
RutaArchivo, _
Quality:=xlQualityMaximum, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
contá = contá + 1
Next
Windows.Application.ScreenUpdating = True
End Sub
Si alguien me puede decir en que estoy fallando o me puede dar una manera de realizarlo.