Hola,

Estoy juntando hojas de distintos libros en uno solo y al copiar las hojas tenia el problema que me almacenaba los numeros como texto. No se practicamente nada de macros pero busco y lo que encuentro intento adaptarlo, he encontrado uno que me va bien por que me cambia los numeros de almacenamiento como texto a numero pero me quita el punto de millar, es decir, esta 1.000 (almacenado como texto) y me lo cambia a 1000(ya como numero) os dejo la macro haber si se puede hacer lo mismo pero sin variar el formato de miles.

Sub Numerar()

Dim r As Range

Dim fila As Long

fila = Application.WorksheetFunction.CountA(Range("D:D"))

If fila = 0 Then Exit Sub

Application.ScreenUpdating = False

For Each r In Range("D2" & ":" & "K" & fila)

On Error Resume Next

If Len® > 0 Then r = (r + 0)

DoEvents

Next

Set r = Nothing

Application.ScreenUpdating = True

'MsgBox "Terminado", vbInformation

End Sub

Gracias por vuestra ayuda.

Buenos dias, lo que necesitas lo puedes hacer facilmente sin macros.

Para consolidar puedes usar la herramienta RDB MERGE, y para convertir los numeros almacenados como texto a numero usa

=valor(celda con el numeor a convertir)[/CODE]

Luego cambias el formato de numero para que te queden con puntos los millares.

Incluso el mismo RDB MERGE tiene la opcion "Paste as Values"

Suerte

Hola,

Ya lo tengo solucionado. Pero quiero que me lo haga en las 15 hojas del libro y ehe probado con la macro adjunto y no lo consigo. ¿Podeis ayudarme?

Sub Numerar()

Dim i As Byte

For i = 1 To ThisWorkbook.Sheets.Count

ThisWorkbook.Sheets(i).Select

Dim r As Range

Dim fila As Long

fila = Application.WorksheetFunction.CountA(Range("D:D"))

If fila = 0 Then Exit Sub

Application.ScreenUpdating = False

For Each r In Range("D2" & ":" & "K" & fila)

Range("D2" & ":" & "K" & fila).NumberFormat = "#,##0.00"

On Error Resume Next

If Len® > 0 Then r = (r + 1)

DoEvents

Next

Set r = Nothing

Next i

Application.ScreenUpdating = True

'MsgBox "Terminado", vbInformation

End Sub

- - - - - Mensaje combinado - - - - -

Tema solucionado. He uilizado lo siguiente:

Sub SepararPalabras()

Application.ScreenUpdating = False

Dim i As Byte

For i = 1 To ThisWorkbook.Sheets.Count

ThisWorkbook.Sheets(i).Select

SepararPalabras_0

SepararPalabras_1

Numerar

Next i

Application.ScreenUpdating = True

End Sub

Quizas no es muy estetico pero para mis pocos conocimientos de macros ya es un gran logro.

Saludos y gracias por vuestro tiempo.