Instrucción en macro para los ceros los sustituya por celda en blanco

En el macro las lineas en negritas solo quiero que los ceros sean remplazados por celdas en blanco y los que hace la instrucción es que si tengo en una celda 0 si lo remplaza por celda en blanco pero si tengo por ejemplo una cantidad de 25,000.00 me lo remplaza por 25.00 y esto ultimo no quiero

Range("A1").Select
Sheets("Consolidado").Select
Cells.Select
Selection.Copy
Sheets("Concentrado").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.Replace What:=0, Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("A1").Select
Columns("B:B").Select
Selection.SpecialCells(xlCellTypeConstants, 23).Select
Application.CutCopyMode = False
Selection.Copy
ActiveWindow.SmallScroll ToRight:=4
Columns("P:P").Select
ActiveSheet.Paste
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Application.CutCopyMode = False
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("C:C").Select
Selection.SpecialCells(xlCellTypeConstants, 23).Select
Selection.Copy
ActiveWindow.SmallScroll ToRight:=3
Columns("Q:Q").Select
ActiveSheet.Paste
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Application.CutCopyMode = False
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("D1").Select
Columns("D:D").Select
Selection.SpecialCells(xlCellTypeConstants, 23).Select
Selection.Copy
ActiveWindow.SmallScroll ToRight:=4
Columns("R:R").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("E:E").Select
Selection.SpecialCells(xlCellTypeConstants, 23).Select
Selection.Copy
ActiveWindow.SmallScroll ToRight:=5
Columns("S:S").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
Columns("F:F").Select
Selection.SpecialCells(xlCellTypeConstants, 23).Select
Selection.Copy
ActiveWindow.SmallScroll ToRight:=5
Columns("T:T").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
Columns("G:G").Select
Selection.SpecialCells(xlCellTypeConstants, 23).Select
Selection.Copy
ActiveWindow.SmallScroll ToRight:=5
Columns("U:U").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
End Sub

1 respuesta

Respuesta
1

Le estás indicando que busque en la "parte" (xlPart) de la celda, en este caso tienes que buscar en la celda completa (xlWhole)

Cambia esta línea:

Selection.Replace What:=0, Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Por esta:

Selection.Replace What:=0, Replacement:="", LookAt:=xlWhole, _
   SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
   ReplaceFormat:=False
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas