Excel VBA - Rows Getting Deleted on running macros.

Hi All,
I have earlier created a job tracking sheet which was fine but was very big horizontally.
Was having difficulties while taking printouts etc. Hence I have been advised to changed.
To accommodate the report in an A4 paper, I have prepare the job in multiple lines (two
lines.). Created two macros - when Column K is having 100%, then the first line of the job
will be moved to next sheet on button click and when Column K is having "OK", the second
line will be moved to the next sheet relevant columns on button click.

The macros are running fine. However, after execution of the macros, the rows from top
are getting deleted. I request your help to get the same corrected.

Attached herewith the file.

Kindly help.

Possibly...

Option Explicit
Sub Graphic2_Click()

'!!! This code deletes data. Test on a copy of your data !!!

    Dim rg As Range

    Application.ScreenUpdating = False
    
    With Worksheets("Discipline")
        Set rg = .Range("a5:k" & Cells(Rows.Count, 11).End(xlUp).Row)
        rg.AutoFilter 11, "OK"
        With rg.SpecialCells(xlCellTypeVisible)
            If .Rows.Count < 2 Then
                MsgBox "Nothing to Refresh", vbExclamation, "Process Incomplete"
            Else
                .Offset(, 1).Resize(, 9).Copy Worksheets("Register").Cells(Rows.Count, 2).End(xlUp).Offset(1)
                .EntireRow.Delete
                MsgBox "Sheet Refreshed", vbExclamation, "Process Complete"
            End If
            Application.CutCopyMode = False
        End With
        rg.AutoFilter
    End With
    
    Application.ScreenUpdating = True
End Sub


Sub TransferFJ()

'!!! This code deletes data. Test on a copy of your data !!!

    Dim rg As Range

    Application.ScreenUpdating = False
    
    With Worksheets("Discipline")
        Set rg = .Range("a5:k" & Cells(Rows.Count, 11).End(xlUp).Row)
        rg.AutoFilter 11, "100%"
        With rg.SpecialCells(xlCellTypeVisible)
            If .Rows.Count < 2 Then
                MsgBox "Dear Team, Only finished job can be transferred. Finish the job first.", vbExclamation, "Process Incomplete"
            Else
                .Offset(, 1).Resize(, 9).Copy Worksheets("Register").Cells(Rows.Count, 2).End(xlUp).Offset(1)
                .EntireRow.Delete
                MsgBox "Dear Team, Congrats !! Good Job. Finished jobs have been trasferred to Register", vbExclamation, "Director's Secretariat"
            End If
            Application.CutCopyMode = False
        End With
        rg.AutoFilter
    End With
    Application.ScreenUpdating = True
    
End Sub

Thanks a lot dangelor.. its working fine now.

Glad I could help!

Hi Dangelor... Even though the initial problem of rows getting deleted has been
solved, I am facing another issue.

The Filtration criterial "OK" is considering only the first rows (Row No.5 and 6).
Consider job of rows 5 & 6 is pending, but job of rows 7 & 8 is finished, the
macro is not working.

Please guide suitably.