Pode ser assim:

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(ActiveCell, Range("H5:I7")) Is Nothing Then Exit Sub

Dim valor   As String
Dim i       As Long

valor = Replace(Format(CStr(ActiveCell.Value2), "0000.00"), ",", "")

For i = 1 To 6
    Cells(ActiveCell.Row, i).Value2 = Mid(valor, i, 1)
Next i

End Sub

Ou assim:

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(ActiveCell, Range("H5:I7")) Is Nothing Then Exit Sub

Dim valor   As String
Dim i       As Long
Dim j       As Long
Dim l       As Long
Dim qtd     As Long

qtd = 6 'digite aqui a quantidade de dígitos que quer considerar

valor = Replace(Format(CStr(ActiveCell.Value2), "0.00"), ",", "")

j = (qtd + 1) - Len(valor)
l = 1
For i = 1 To qtd
    If i < j Then
        Cells(ActiveCell.Row, i).ClearContents
    Else
        Cells(ActiveCell.Row, i).Value2 = Mid(valor, l, 1)
        l = l + 1
    End If
Next i

End Sub

Gtsalikis,
É quase isso.
Você conseguiria escrever o macro de forma que ele colocasse os valores nas mesmas células?
Ao clicar em qualquer célula da matriz (H5:I7), os algarismos do valor selecionado irem para as células. Por exemplo, clicando em 5,24 ir para C5 = 5;D5 = 2; E5 = 4, clicando em 6,84 ir para C5 = 6; D5 = 8; E5 = 4 e assim sucessivamente. Retirando os zeros que ficaram anteriores.

Nessa parte do macro antigo (Then Range("AB2").Value2 = ActiveCell.Value2]), ela faz com que eu escolha para onde o valor vai. Você reescreveria esse macro novo colocando essa parte do antigo pra que eu pudesse colocar os algarismos em células de minha escolha ?
Ficando mais ou menos assim : Then Range("1° algarismo = C5").Value2 = ActiveCell.Value2; Then Range("2° algarismo = D5").Value2 = ActiveCell.Value2; Then Range("3° algarismo = E5").Value2 = ActiveCell.Value2. Sei que tá completamente errado isso que escrevi..Hahaha, é só pra demonstrar.

Att.

acarloos

Veja agora:

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(ActiveCell, Range("H5:I7")) Is Nothing Then Exit Sub

Dim valor   As String
Dim i       As Long
Dim j       As Long
Dim l       As Long
Dim k       As Long
Dim h       As Long
Dim qtd     As Long
Dim destin  As Range

qtd = 6 'digite aqui a quantidade de dígitos que quer considerar
Set destin = Range("A1") 'coloque aqui a célula onde vai começar a distribuir

k = destin.Row
h = destin.Column

valor = Replace(Format(CStr(ActiveCell.Value2), "0.00"), ",", "")

j = qtd - Len(valor)
l = 1
For i = h To qtd + h
    If i < j Then
        Cells(k, i).ClearContents
    Else
        Cells(k, i).Value2 = Mid(valor, l, 1)
        l = l + 1
    End If
Next i

End Sub

Gtsalikis,

Muito Obrigado, ficou bom demais aqui!
Só te perguntar mais uma coisa : Quero inserir mais intervalos, onde eu os colocaria?

Vc pode usar esta linha:
If Intersect(ActiveCell, Range("H5:I7")) Is Nothing Then Exit Sub

Coloque o novo intevalo com o comando OR, ficaria assim:
If Intersect(ActiveCell, Range("H5:I7")) Is Nothing Or Intersect(ActiveCell, Range("A1:B5")) Is Nothing Then Exit Sub

Mais uma vez Gtsalikis, Muito Obrigado.. Funcionando do jeito que eu queria!!
Extremamente grato pela ajuda!

Att.

acarloos

Não consegui fazer aqui não, me manda o macro completo. Quando coloco o comando OR os valores acabam não aparecendo aqui mas assim que retiro volta a funcionar.

Gtsalikis,
Você poderia me enviar o macro com mais intervalos? Tentei inserir o comando "OR" mas não deu certo.

Att.

Veja se agora ajuda:

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim valor       As String
Dim i           As Long
Dim j           As Long
Dim l           As Long
Dim k           As Long
Dim h           As Long
Dim qtd         As Long
Dim destin      As Range
Dim intervalo() As Range

j = 4 'Coloque aqui a quantidade de intervalos que vai usar

ReDim intervalo(1 To 4) As Range

Set intervalo(1) = Range("H5:I7") 'Para cada novo intervalo, repita essa linha, e aumente um numero no contador do intervalo
Set intervalo(2) = Range("J5:K7") 'Para cada novo intervalo, repita essa linha, e aumente um numero no contador do intervalo
Set intervalo(3) = Range("L5:M7") 'Para cada novo intervalo, repita essa linha, e aumente um numero no contador do intervalo
Set intervalo(4) = Range("N5:O7") 'Para cada novo intervalo, repita essa linha, e aumente um numero no contador do intervalo


For i = 1 To j
    If Not Intersect(ActiveCell, intervalo(i)) Is Nothing Then GoTo DISTRIBUIR
Next i
Exit Sub

DISTRIBUIR:

qtd = 6 'digite aqui a quantidade de dígitos que quer considerar
Set destin = Range("A1") 'coloque aqui a célula onde vai começar a distribuir

k = destin.Row
h = destin.Column

valor = Replace(Format(CStr(ActiveCell.Value2), "0.00"), ",", "")

j = qtd - Len(valor)
l = 1
For i = h To qtd + h
    If i < j Then
        Cells(k, i).ClearContents
    Else
        Cells(k, i).Value2 = Mid(valor, l, 1)
        l = l + 1
    End If
Next i

End Sub

Boa tarde Gtsalikis,

Gostaria da sua ajuda mais uma vez.

I) Você aumentou os intervalos como eu pedi. A alteração que eu gostaria que você fizesse é a
seguinte : A parte de DISTRIBUIR os algarismos nas células fossem também aumentados os intervalos.
Assim, supondo que eu queira que os do intervalo(1) vão para C5, intervalo(2) para C7,
intervalo(3) para C9 e assim por diante, sendo para o meu caso aqui, eu sempre escolhendo todos os intervalos tanto
onde os números estão como também para onde seus algarismos estão indo.
Ex:
Set intervalo(1) = Range("H5:I7") 'Para cada novo intervalo, repita essa linha, e aumente um numero no contador do intervalo
Set intervalo(2) = Range("H9:I11") 'Para cada novo intervalo, repita essa linha, e aumente um numero no contador do intervalo
Set intervalo(3) = Range("K5:L7") 'Para cada novo intervalo, repita essa linha, e aumente um numero no contador do intervalo
Set intervalo(4) = Range("K9:L11") 'Para cada novo intervalo, repita essa linha, e aumente um numero no contador do intervalo

DISTRIBUIR:

qtd = 3 'digite aqui a quantidade de dígitos que quer considerar
Set destin "intervalo(1)" = Range("C5") 'coloque aqui a célula onde vai começar a distribuir
Set destin "intervalo(2)" = Range("C7") 'coloque aqui a célula onde vai começar a distribuir
Set destin "intervalo(3)" = Range("C9") 'coloque aqui a célula onde vai começar a distribuir
Set destin "intervalo(4)" = Range("C11") 'coloque aqui a célula onde vai começar a distribuir

II) Fazer um macro com os mesmos atributos acima só que ao invés dos algarismos irem nessa ordem "0.00", eles fossem
dessa forma "00.0" . Na planilha igualei os valores das células pra você como fica.

Obs: Nesses casos acima, você pode juntar os 2 macros ou então fazê-los separadamente. Escolha o que fica melhor pra você.

Att,

acarloos

Ajustei e ficou assim:

    Option Explicit
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim valor       As String
    Dim i           As Long
    Dim j           As Long
    Dim l           As Long
    Dim k           As Long
    Dim h           As Long
    Dim qtd         As Long
    Dim destin()    As Range
    Dim intervalo() As Range

    j = 4 'Coloque aqui a quantidade de intervalos que vai usar

    ReDim intervalo(1 To j) As Range
    ReDim destin(1 To j) As Range
    
    Set intervalo(1) = Range("H5:I7") 'Para cada novo intervalo, repita essa linha, e aumente um numero no contador do intervalo
    Set intervalo(2) = Range("H9:I11") 'Para cada novo intervalo, repita essa linha, e aumente um numero no contador do intervalo
    Set intervalo(3) = Range("K5:L7") 'Para cada novo intervalo, repita essa linha, e aumente um numero no contador do intervalo
    Set intervalo(4) = Range("K9:L11") 'Para cada novo intervalo, repita essa linha, e aumente um numero no contador do intervalo

    Set destin(1) = Range("C5") 'coloque aqui a célula correspondente ao intervalo
    Set destin(2) = Range("C7") 'coloque aqui a célula correspondente ao intervalo
    Set destin(3) = Range("C9") 'coloque aqui a célula correspondente ao intervalo
    Set destin(4) = Range("C11") 'coloque aqui a célula correspondente ao intervalo

    For i = 1 To j
        If Not Intersect(ActiveCell, intervalo(i)) Is Nothing Then GoTo DISTRIBUIR
    Next i
    Exit Sub

DISTRIBUIR:

    qtd = 3 'digite aqui a quantidade de dígitos que quer considerar

    k = destin(i).Row
    h = destin(i).Column

    valor = Replace(Format(CStr(ActiveCell.Value2), "0.00"), ",", "")

    j = qtd - Len(valor)
    l = 1
    For i = h To qtd + h
        If i < j Then
            Cells(k, i).ClearContents
        Else
            Cells(k, i).Value2 = Mid(valor, l, 1)
            l = l + 1
        End If
    Next i

    End Sub

Sobre a formatação:

II) Fazer um macro com os mesmos atributos acima só que ao invés dos algarismos irem nessa ordem "0.00", eles fossem
dessa forma "00.0" . Na planilha igualei os valores das células pra você como fica.

vc mesmo pode alterar nessa linha:

valor = Replace(Format(CStr(ActiveCell.Value2), "0.00"), ",", "")

Para:

valor = Replace(Format(CStr(ActiveCell.Value2), "00.0"), ",", "")

O macro ficou do jeito que eu pensava. Quanto a formatação, quando eu coloco "00.0", retorna esse valor nas células (0 ; 6 ; 8) ao invés de (4 ; 8 ; 6).

Vc quer pasar os números na ordem invertida?

Seria assim:

    Option Explicit
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim valor       As String
    Dim i           As Long
    Dim j           As Long
    Dim l           As Long
    Dim k           As Long
    Dim h           As Long
    Dim qtd         As Long
    Dim destin()    As Range
    Dim intervalo() As Range

    j = 4 'Coloque aqui a quantidade de intervalos que vai usar

    ReDim intervalo(1 To j) As Range
    ReDim destin(1 To j) As Range
    
    Set intervalo(1) = Range("H5:I7") 'Para cada novo intervalo, repita essa linha, e aumente um numero no contador do intervalo
    Set intervalo(2) = Range("H9:I11") 'Para cada novo intervalo, repita essa linha, e aumente um numero no contador do intervalo
    Set intervalo(3) = Range("K5:L7") 'Para cada novo intervalo, repita essa linha, e aumente um numero no contador do intervalo
    Set intervalo(4) = Range("K9:L11") 'Para cada novo intervalo, repita essa linha, e aumente um numero no contador do intervalo

    Set destin(1) = Range("C5") 'coloque aqui a célula correspondente ao intervalo
    Set destin(2) = Range("C7") 'coloque aqui a célula correspondente ao intervalo
    Set destin(3) = Range("C9") 'coloque aqui a célula correspondente ao intervalo
    Set destin(4) = Range("C11") 'coloque aqui a célula correspondente ao intervalo

    For i = 1 To j
        If Not Intersect(ActiveCell, intervalo(i)) Is Nothing Then GoTo DISTRIBUIR
    Next i
    Exit Sub

DISTRIBUIR:

    qtd = 3 'digite aqui a quantidade de dígitos que quer considerar

    k = destin(i).Row
    h = destin(i).Column

    valor = Replace(Format(CStr(ActiveCell.Value2), "0.00"), ",", "")

    j = qtd - Len(valor)
    l = qtd
    For i = h To qtd + h
        If i < j Then
            Cells(k, i).ClearContents
        Else
            Cells(k, i).Value2 = Mid(valor, l, 1)
            l = l - 1
            If l <= 0 Then Exit For
        End If
    Next i

    End Sub

Ficou ótimo!!. Eu só quero saber mais uma coisa.. Como eu junto os 2 ? Porque tô tentando juntar e tá aparecendo essa mensagem : "Declaração duplicada no escopo atual"