Ayuda con macro

[Piyin]

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.

[LIKO28]

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

[Piyin]

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.