Macro para cambiar números a letras no funciona en otros archivos

Prueba la siguiente macro Crear_Archivos, incluye convertir el número en letras.

Debes copiar TODO el código.

Sub Crear_Archivos()
'
'POR DANTE AMOR
'
  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("listado.xlsx")
  Set wb2 = Workbooks("nota crédito.xlsx")
  Set sh1 = wb1.Sheets("Hoja1")
  Set sh2 = wb2.Sheets("Hoja1")
  '
  ruta = "C:\2 BOMBEROS\BOMBEROS VOLUNTARIOS\"
  ruta = "C:\trabajo\"
  '
  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 = 14
  For i = 2 To lr + 1
    If fact <> sh1.Range("A" & i).Value Then
      sh3.Range("A38").Value = CONVERTIRNUM(sh3.Range("C36").Value)
      wb3.SaveAs rutafin & "\" & 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 = 15
    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
    '
    fact = sh1.Range("A" & i).Value
    rutafin = ruta & fact
  Next
  '
  Application.ScreenUpdating = True
  MsgBox "Fin"
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
'
Function CONVERTIRNUM(Numero As Double, Optional CentimosEnLetra As Boolean) As String
  Dim Moneda As String
  Dim Monedas As String
  Dim Centimo As String
  Dim Centimos As String, letracentimos As String
  Dim Preposicion As String
  Dim NumCentimos As Double
  Dim Letra As String
  Const Maximo = 1999999999999.99
  Moneda = "Peso"         'Nombre de Moneda (Singular)
  Monedas = "Pesos"       'Nombre de Moneda (Plural)
  Centimo = "Centavo"     'Nombre de Céntimos (Singular)
  Centimos = "Centavos"   'Nombre de Céntimos (Plural)
  Preposicion = "Con"     'Preposición entre Moneda y Céntimos
  ''Validar que el Numero está dentro de los límites
  If (Numero >= 0) And (Numero <= Maximo) Then
    Letra = NUMERORECURSIVO(Fix(Numero))              'Convertir el Numero en letras
    'Si Numero = 1 agregar leyenda Moneda (Singular)
'    If (Numero = 1) Then
'      Letra = Letra & " " '& Moneda
'      'De lo contrario agregar leyenda Monedas (Plural)
'    Else
'      Letra = Letra & " " '& Monedas
'    End If
    NumCentimos = Round((Numero - Fix(Numero)) * 100)   'Obtener los centimos del Numero
    'Si NumCentimos es mayor a cero inicar la conversión
    If NumCentimos >= 0 Then
      'Si el parámetro CentimosEnLetra es VERDADERO obtener letras para los céntimos
      If CentimosEnLetra Then
        Letra = Letra & " " & Preposicion & " " & NUMERORECURSIVO(Fix(NumCentimos)) 'Convertir los céntimos en letra
        'Si NumCentimos = 1 agregar leyenda Centimos (Singular)
        If (NumCentimos = 1) Then
          Letra = Letra & " " '& Centimo
          'De lo contrario agregar leyenda Centimos (Plural)
        Else
          Letra = Letra & " " '& Centimos
        End If
        'De lo contrario mostrar los céntimos como número
      Else
        letracentimos = Preposicion & " " & Format(NumCentimos, "00") & "/100"
      End If
    End If
'    If Right(Letra, 9) = "Millones " Then
'      Letra = Letra & "de "
'    End If
    'Regresar el resultado final de la conversión
    CONVERTIRNUM = UCase(Letra & " " & letracentimos & " " & Monedas)
  Else
    'Si el Numero no está dentro de los límites, entivar un mensaje de error
    CONVERTIRNUM = "ERROR: El número excede los límites."
  End If
End Function
'
Function NUMERORECURSIVO(Numero As Double) As String
  Dim Unidades, Decenas, Centenas
  Dim Resultado As String
  '**************************************************
  ' Nombre de los números
  '**************************************************
  Unidades = Array("", "Uno", "Dos", "Tres", "Cuatro", "Cinco", "Seis", "Siete", "Ocho", "Nueve", "Diez", "Once", "Doce", "Trece", "Catorce", "Quince", "Dieciséis", "Diecisiete", "Dieciocho", "Diecinueve", "Veinte", "Veintiun", "Veintidos", "Veintitres", "Veinticuatro", "Veinticinco", "Veintiseis", "Veintisiete", "Veintiocho", "Veintinueve")
  Decenas = Array("", "Diez", "Veinte", "Treinta", "Cuarenta", "Cincuenta", "Sesenta", "Setenta", "Ochenta", "Noventa", "Cien")
  Centenas = Array("", "Ciento", "Doscientos", "Trescientos", "Cuatrocientos", "Quinientos", "Seiscientos", "Setecientos", "Ochocientos", "Novecientos")
  '**************************************************
  Select Case Numero
    Case 0
        Resultado = "Cero"
    Case 1 To 29
        Resultado = Unidades(Numero)
    Case 30 To 100
        Resultado = Decenas(Numero \ 10) + IIf(Numero Mod 10 <> 0, " y " + NUMERORECURSIVO(Numero Mod 10), "")
    Case 101 To 999
        Resultado = Centenas(Numero \ 100) + IIf(Numero Mod 100 <> 0, " " + NUMERORECURSIVO(Numero Mod 100), "")
    Case 1000 To 1999
        Resultado = "Mil" + IIf(Numero Mod 1000 <> 0, " " + NUMERORECURSIVO(Numero Mod 1000), "")
    Case 2000 To 999999
        Resultado = NUMERORECURSIVO(Numero \ 1000) + " Mil" + IIf(Numero Mod 1000 <> 0, " " + NUMERORECURSIVO(Numero Mod 1000), "")
    Case 1000000 To 1999999
        Resultado = "Un Millón" + IIf(Numero Mod 1000000 <> 0, " " + NUMERORECURSIVO(Numero Mod 1000000), "")
    Case 2000000 To 1999999999
        Resultado = NUMERORECURSIVO(Numero \ 1000000) + " Millones" + IIf(Numero Mod 1000000 <> 0, " " + NUMERORECURSIVO(Numero Mod 1000000), "")
  End Select
  NUMERORECURSIVO = Resultado
End Function