Rellenar con 0

Te dejo este código
Sub Macro1()
    Dim sCelda As String
    Dim nFila As Long
    Dim nCuantasFilas As Long
    Range("D1").Select
    Selection.End(xlDown).Select
    nCuantasFilas = Selection.Row
    For nFila = 1 To nCuantasFilas
        sCelda = "D" & nFila
        Range(sCelda).NumberFormat = "@"
        Range(sCelda).Value = Ceros(Range(sCelda).Value) & Range(sCelda).Value
    Next
End Sub
Function Ceros(ByVal nValor As Long) As String
    Dim I As Integer
    Ceros = ""
    If 15 - Len(Trim(Str(Int(nValor)))) = 0 Then Exit Function
    For I = 1 To 15 - Len(Trim(Str(Int(nValor))))
        Ceros = Ceros & "0"
    Next
End Function

Cada vez que ejecuto el macro me cuelga el excel, a pesar que lo he puesto en un hoja con datos más pequeños. ¿A qué se debe eso o es que falta algo más?
De antemano gracias !

En el código que te puse tome como referencia que tus datos están en la columna D
Lo que la MACRO hace es colocarse en la celda D1 y luego se desplaza hacia abajo para saber cuantas filas son en total
Luego inicia un ciclo que va tomando el valor de cada celda y rellenándolo con ceros
Si puedes envíame una copia de tu archivo y te ayudo con la solución
[email protected]

Acabo de enviarte a tu correo para que me puedas ayudar, bueno si el macro se ejecuta sin normalidad pero como hago con los decimales, lo que estuve haciendo es primero multiplicarlo por 100 y luego ejecutarlo en el macro.

Hice unos cambios, te dejo el código y te envío el archivo con la MACRO
Sub Macro1()
    Dim nFila As Long
    Dim nCuantasFilas As Long
    Range("D8").Select
    Selection.End(xlDown).Select
    nCuantasFilas = Selection.Row
    For nFila = 8 To nCuantasFilas
        Range("J" & nFila).NumberFormat = "@"
        Range("J" & nFila).Value = Ceros(Range("D" & nFila).Value) & Replace(Range("D" & nFila).Value, ".", "")
    Next
End Sub
Function Ceros(ByVal nValor As String) As String
    Dim I As Integer
    Ceros = ""
    nValor = Trim(Replace(nValor, ".", ""))
    If 15 - Len(nValor) = 0 Then Exit Function
    For I = 1 To 15 - Len(nValor)
        Ceros = Ceros & "0"
    Next
End Function

Hola Experto gracias la verdad que me esta sirviendo de mucho tu ayuda pero tengo algunas consultas que ojala tengas tiempo de poderme ayudar. Te acabo de enviar la duda a tu correo. Mil gracias !

Ya hice los ajustes y te devolví el archivo
Sub Macro1()
    Dim nFila As Long
    Dim nCuantasFilas As Long
    Range("D8").Select
    Selection.End(xlDown).Select
    nCuantasFilas = Selection.Row
    For nFila = 8 To nCuantasFilas
        Range("J" & nFila).NumberFormat = "@"
        Range("J" & nFila).Value = Ceros(Trim(Str(Range("D" & nFila).Value)))
    Next
End Sub
Function Ceros(ByVal nValor As String) As String
    Dim sEntero As String
    Dim sDecimal As String
    Dim I As Integer
    If 15 - Len(nValor) = 0 Then Exit Function
    Ceros = ""
    If InStr(1, nValor, ".") > 0 Then
        sEntero = Left(nValor, InStr(1, nValor, ".") - 1)
        sDecimal = Right(nValor, Len(nValor) - InStr(1, nValor, "."))
        nValor = sEntero & Left(sDecimal, 2)
    Else
        nValor = Trim(nValor) & "00"
    End If
    For I = 1 To 15 - Len(nValor)
        Ceros = Ceros & "0"
    Next
    Ceros = Ceros & nValor
End Function