How to search for zero in sheet

[Guest]

I want to delete zeroes at the end of a column. I want to delete everyone
except one. I have several columns with between 500 to 2000 rows. At the end
of each column there are several zeroes. I want to delete and keep only one
of them to shorten the number of rows. The sheet looks something like this:

A B C D E F
0 0 0 0 0 0
0 0 0 0 0 0
0 0 0 0 0 0
1 2 3 1 2 4
2 5 5 5 5 5
4 2 3 2 2 5
2 2 5 2 3 2
2 3 1 2 2 5
5 8 2 1 1 6
3 5 1 2 2 2
2 1 2 8 2 1
1 2 1 5 5 2
0 2 5 2 2 0
0 5 2 0 0 0
0 0 2 0 0 0
0 0 0 0 0 0
0 0 0 0 0
0 0
0 0

I do not want to delete the zeroes at the beginning of every column. Just at
the end. It is also important that the macro do not delete all of the zeroes.
I want one of them to stay at the end of the row.
Can anyone help me?

 

[Guest]

Hi,
Try this:

With Worksheets("Sheet1")
For c = 1 To 6
LastRow = .Cells(Rows.Count, c).End(xlUp).Row
For r = LastRow To 1 Step -1
If .Cells(r - 1, c) = 0 Then
.Cells(r, c).Delete shift:=xlUp
Else
Exit For
End If
Next r
Next c
End With

 

[Guest]

Thank you very much! Works great!

Toppers skrev:

Hi,
Try this:

With Worksheets("Sheet1")
For c = 1 To 6
LastRow = .Cells(Rows.Count, c).End(xlUp).Row
For r = LastRow To 1 Step -1
If .Cells(r - 1, c) = 0 Then
.Cells(r, c).Delete shift:=xlUp
Else
Exit For
End If
Next r
Next c
End With