delete specific rows in excel sheet3

Hi,
Could you expalin exactly what you want help with as it is not clear?

If I am reading it correctly try the code below on a copy of your data

Sub test()
    Application.ScreenUpdating = False
    Dim i As Long, LstRw As Long, LstCo As Long
    With Sheets("Sheet3")
    LstCo = Cells.Find(What:="*", SearchOrder:=xlColumns, SearchDirection:=xlPrevious, LookIn:=xlValues).Column + 1
    LstRw = .Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
    .Columns(1).Insert
    With .Range("b1:b" & LstRw)
        With .Columns(1).Offset(, -1)
            For i = 1 To LstRw Step 50
                .Cells(i, 1).Value = "a"
            Next
        End With
         End With
        With .Range(Cells(1, 1), Cells(LstRw, LstCo))
            .Sort key1:=.Cells(1), order1:=1, Header:=xlNo
        End With
   With .Columns(1)
        .SpecialCells(2, 2).EntireRow.Delete
        .Delete
    End With
    End With
    Application.ScreenUpdating = True
End Sub

The above code only deletes the first row

I am a bit puzzled here. On my data it deletes rows
1
51
101
151
201
251
301
351
401
451
501
et cetera

The above code only deletes the first row (which I want to keep and delete the rest others)

Your original post deletes the first row

 Rows("1:1").Select
    Selection.Delete Shift:=xlUp

Run the code below. What lines have an "a" in column A and which rows do you want to delete (list the first 5 rows to delete from the original data)?

Sub test()
    'Application.ScreenUpdating = False
    Dim i As Long, LstRw As Long, LstCo As Long
    With Sheets("Sheet3")
    LstCo = Cells.Find(What:="*", SearchOrder:=xlColumns, SearchDirection:=xlPrevious, LookIn:=xlValues).Column + 1
    LstRw = .Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
    .Columns(1).Insert
    With .Range("b1:b" & LstRw)
        With .Columns(1).Offset(, -1)
            For i = 1 To LstRw Step 50
                .Cells(i, 1).Value = "a"
            Next
        End With
        End With
        End With
        End Sub

Deleted rushed editing

See last post as your last post has registered but not mine

My fault

Sub test()
    Application.ScreenUpdating = False
    Dim i As Long, LstRw As Long, LstCo As Long
    With Sheets("Sheet3")
    LstCo = Cells.Find(What:="*", SearchOrder:=xlColumns, SearchDirection:=xlPrevious, LookIn:=xlValues).Column + 1
    LstRw = .Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row
    .Columns(1).Insert
    With .Range("b1:b" & LstRw)
        With .Columns(1).Offset(, -1)
            For i = 52 To LstRw Step 51
                .Cells(i, 1).Value = "a"
            Next
        End With
         End With
        With .Range(Cells(1, 1), Cells(LstRw, LstCo))
            .Sort key1:=.Cells(1), order1:=1, Header:=xlNo
        End With
   With .Columns(1)
        .SpecialCells(2, 2).EntireRow.Delete
        .Delete
    End With
    End With
    Application.ScreenUpdating = True
End Sub

Happy we got there. Remember to mark the thread as solved if you feel your question has been answered.