Delete last line

[gnusmas]

Hi freind 1 need vba code to delete last line for each group.
exemple Sheet1

02	19	25	30	32	39
01	12	14	31	32	46
10	19	21	24	33	35
04	18	34	36	40	47
01	03	39	41	45	49
01	05	13	45	47	49
11	17	23	26	31	38
04	15	16	17	19	20
03	06	07	12	33	47
02	06	09	28	39	49
08	20	22	24	34	49
01	03	14	23	25	26
09	11	26	27	36	46
03	26	32	43	45	47
07	11	18	22	27	39

<colgroup><col span="6"></colgroup><tbody>
</tbody>

Sheet 2 result like this

02	19	25	30	32	39
01	12	14	31	32	46
10	19	21	24	33	35
04	18	34	36	40	47
01	05	13	45	47	49
11	17	23	26	31	38
04	15	16	17	19	20
03	06	07	12	33	47
08	20	22	24	34	49
01	03	14	23	25	26
09	11	26	27	36	46
03	26	32	43	45	47

<colgroup><col span="6"></colgroup><tbody>
</tbody>

Thank you for help

 

[FormR]

Give this a try on a copy of your worksheet, assumes your data is in columns A:F.

Sub DeleteSomeRows()
Dim r As Range, a As Range, lr As Long
lr = Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next
    Set r = Range("A1:F" & lr).SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Not r Is Nothing Then
    For Each a In r.Areas
        If a.Rows.Count = 1 Then
            Rows(a.Row).Delete
                Else
            Rows(a.End(xlDown).Row).Delete
        End If
    Next a
End If
End Sub

 

[gnusmas]

Good job Bravo!!

Give this a try on a copy of your worksheet, assumes your data is in columns A:F.

Sub DeleteSomeRows()
Dim r As Range, a As Range, lr As Long
lr = Range("A" & Rows.Count).End(xlUp).Row
On Error Resume Next
    Set r = Range("A1:F" & lr).SpecialCells(xlCellTypeConstants)
On Error GoTo 0
If Not r Is Nothing Then
    For Each a In r.Areas
        If a.Rows.Count = 1 Then
            Rows(a.Row).Delete
                Else
            Rows(a.End(xlDown).Row).Delete
        End If
    Next a
End If
End Sub