Macro is getting ruined

[M3L333]

I have been re-working this macro for quite some time. First started by pasting info to new sheet on last row, then successfully changed the macro to insert a new row on top and paste to new sheet. Then noticed that the sheet i was pasting to only was moving the row down in certain columns. I want to entire row to move down....now the macro doesn't seem to be pasting to a new sheet at all. I need help PLEASE!! Make my macro work again.


Private Sub CommandButton1_Click()


Dim lr As Long
Dim r As Long
Dim nr As Long


Application.ScreenUpdating = False


'Find lr column P with data on Bed Registry
lr = Sheets("Bed Registry").Cells(Rows.Count, "P").End(xlUp).Row


'Find lcol - Last Column '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'lcol = Sheets("Bed Registry").ActiveSheet.Cells(1, Application.Columns.Count).End(xlToRight).Column


'Loop through all rows on Bed Registry and check column P for closed
For r = 2 To lr
If Sheets("Bed Registry").Cells(r, "P") = "CLOSED" Then
'Sheets("Discharges").Activate
'Insert r at r2 on "Discharges" Sheet
'Rows("2:2").Insert Shift:=xlDown,
'CopyOrigin:=xlFormatFromLeftOrAbove
'Copy columns B-P to "Discharges" on row 2
'Sheets("Bed Registry").Range(Cells(r, "B"), Cells(r, "P")).Copy Sheets("Discharges").Range (Cells(2, "B"), (Cells r, "P"))
'Clear columns B-P on Bed Registry
Sheets("Bed Registry").Range(Cells(r, "B"), Cells(r, "P")).ClearContents
End If
Next r


End Sub

 

[Fluff]

Duplicate https://www.mrexcel.com/forum/excel-questions/1072075-small-adjustment-macro.html#post5149690

Please do not post the same question multiple times. All clarifications, follow-ups, and bumps should be posted back to the original thread.
Per forum rules, posts of a duplicate nature will be locked or deleted (rule 12 here: Forum Rules).