VBA copy and paste based on cell value

Sub Shift()

Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("Histogram").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("DS Sheet").Cells(Rows.Count, "A").End(xlUp).Row
lr3 = Sheets("NS Sheet").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
    If Range("E" & r).Value = "DS" Then
       lr2 = Sheets("DS Sheet").Cells(Rows.Count, "A").End(xlUp).Row
        Range("B" & r).Resize(, 6).Copy Sheets("DS Sheet").Range("A" & lr2 + 1)
       
    ElseIf Range("E" & r).Value = "NS" Then
        lr3 = Sheets("NS Sheet").Cells(Rows.Count, "A").End(xlUp).Row
        Range("B" & r).Resize(, 6).Copy Sheets("DS Sheet").Range("A" & lr3 + 1)

    End If

Next r
End Sub

 Sub Shiftmine()

Dim lr As Long, r As Long
lr = Sheets("Histogram").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
    If Range("E" & r).Value = "DS" Then
        Range("B" & r).Resize(, 6).Copy Sheets("DS Sheet").Sheets("DS Sheet").Cells(Rows.Count, "A").End(xlUp).Offset(1)
    ElseIf Range("E" & r).Value = "NS" Then
        Range("B" & r).Resize(, 6).Copy Sheets("DS Sheet").Sheets("NS Sheet").Cells(Rows.Count, "A").End(xlUp).Offset(1)
    End If
Next r
End Sub