Eliminar valores 0 desde la columna B hasta la fila Z
Tengo la siguiente macro
Sub Macro2()
'Por Dante Amor
Dim lr As Long, i As Long, a As Variant, r As Range
Application.ScreenUpdating = False
lr = Range("A" & Rows.Count).End(xlUp).Row
Set r = Range("A" & lr + 1) 'establece la siguiente fila a la última fila con datos
a = Range("A1:A" & lr)
For i = 1 To UBound(a)
If a(i, 1) = "0" Then Set r = Union(r, Range("A" & i))
Next i
r.EntireRow.Delete
Application.ScreenUpdating = True
End Subnecesito que esa macro se ejecute desde la columna B hasta la columna Z
Es decir que elimine los valores 0 de cada columna y coloque cada refistro uno debajo del otro.
1 Respuesta
Respuesta de Dante Amor
2
Asi estaria original
Y este seria el resultado
Los nombres son muchos hacia abajo. Y deberían correrse columna por columna hacia arriba sin afectar una columna a l ala otra
Ejecuta la siguiente macro:
Sub EliminarCeros()
Dim sh As Worksheet
Dim a As Variant, b As Variant
Dim lr As Long, lc As Long, i As Long, j As Long, x As Long, y As Long
Set sh = Sheets("Nombres")
lr = sh.UsedRange.Rows(sh.UsedRange.Rows.Count).Row
lc = sh.UsedRange.Columns(sh.UsedRange.Columns.Count).Column
a = sh.Range("B1", sh.Cells(lr, lc)).Value
ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
For j = 1 To UBound(a, 2)
x = 0
For i = 1 To UBound(a, 1)
If a(i, j) <> "" And a(i, j) <> 0 Then
x = x + 1
b(x, j) = a(i, j)
End If
Next
Next
sh.Range("B1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub
