VBA Code Update Help - moving a row to a new sheet based on cell data

[cmschmitz24]

I tried reusing an existing code that works for a different spreadsheet to update it and use it with a new spreadsheet and data set but it's bugging out. Someone please help It bugs out on "Rng.EntireRow.Copy Worksheets("REH Annuitant").Range("A" & lastrow2 + 1)". The third to last row of code.

Sub TEST()
'Moves REH Annuitants to a New Sheet
 Dim Rng As Range, r As Long, lastrow2 As Long, Lastrow As Long
    Application.ScreenUpdating = False

    Lastrow = Worksheets("MSC").UsedRange.Rows.Count
    lastrow2 = Worksheets("REH Annuitant").UsedRange.Rows.Count
    If lastrow2 = 1 Then lastrow2 = 0
        For r = Lastrow To 2 Step -1
            If Range("G" & r).Value = "S" Then
                If Rng Is Nothing Then
                    Set Rng = Range("A" & r)
                Else
                    Set Rng = Union(Rng, Range("A" & r))
                End If
            End If
        Next r
        Rng.EntireRow.Copy Worksheets("REH Annuitant").Range("A" & lastrow2 + 1)
        Rng.EntireRow.Delete
    Application.ScreenUpdating = True
End Sub

*Data in columns D/E has been removed.

 

[Fluff]

Can you report the code as it is now?

 

[cmschmitz24]

'MOVES REHIRED ANNUITANTS TO NEW TAB
    Dim Rng As Range, r As Long, lastrow2 As Long
    Application.ScreenUpdating = False

    Lastrow = Worksheets("MSC").UsedRange.Rows.Count
    lastrow2 = Worksheets("REH Annuitant").UsedRange.Rows.Count
    If lastrow2 = 1 Then lastrow2 = 0
        For r = Lastrow To 2 Step -1
            If Range("L" & r).Value = "REH Annuitant" Then
                If Rng Is Nothing Then
                    Set Rng = Range("A" & r)
                Else
                    Set Rng = Union(Rng, Range("A" & r))
                End If
            End If
        Next r
      If Not Rng Is Nothing Then
         Rng.EntireRow.Copy Worksheets("REH Annuitant").Range("A" & lastrow2 + 1)
         Rng.EntireRow.Delete
      End If
    Application.ScreenUpdating = True
    
    
'MOVES GRAD WRS MOVEMENTS TO NEW TAB
    Application.ScreenUpdating = False
    
    Lastrow = Worksheets("MSC").UsedRange.Rows.Count
    lastrow2 = Worksheets("Grad WRS Movement").UsedRange.Rows.Count
    If lastrow2 = 1 Then lastrow2 = 0
        For r = Lastrow To 2 Step -1
            If Range("L" & r).Value = "Grad WRS Movement" Then
                If Rng Is Nothing Then
                    Set Rng = Range("A" & r)
                Else
                    Set Rng = Nothing
                End If
            End If
        Next r
      If Not Rng Is Nothing Then
         Rng.EntireRow.Copy Worksheets("Grad WRS Movement").Range("A" & lastrow2 + 1)
         Rng.EntireRow.Delete
      End If
    Application.ScreenUpdating = True

 

[Fluff]

You've put it in the wrong place, it should be like

'MOVES REHIRED ANNUITANTS TO NEW TAB
    Dim Rng As Range, r As Long, lastrow2 As Long
    Application.ScreenUpdating = False

    LASTROW = Worksheets("MSC").UsedRange.Rows.Count
    lastrow2 = Worksheets("REH Annuitant").UsedRange.Rows.Count
    If lastrow2 = 1 Then lastrow2 = 0
        For r = LASTROW To 2 Step -1
            If Range("L" & r).Value = "REH Annuitant" Then
                If Rng Is Nothing Then
                    Set Rng = Range("A" & r)
                Else
                    Set Rng = Union(Rng, Range("A" & r))
                End If
            End If
        Next r
      If Not Rng Is Nothing Then
         Rng.EntireRow.Copy Worksheets("REH Annuitant").Range("A" & lastrow2 + 1)
         Rng.EntireRow.Delete
      End If
    Application.ScreenUpdating = True
    
   Set Rng = Nothing
    
'MOVES GRAD WRS MOVEMENTS TO NEW TAB
    LASTROW = Worksheets("MSC").UsedRange.Rows.Count
    lastrow2 = Worksheets("Grad WRS Movement").UsedRange.Rows.Count
    If lastrow2 = 1 Then lastrow2 = 0
        For r = LASTROW To 2 Step -1
            If Range("L" & r).Value = "Grad WRS Movement" Then
                If Rng Is Nothing Then
                    Set Rng = Range("A" & r)
                Else
                    Set Rng = Union(Rng, Range("A" & r))
                End If
            End If
        Next r
      If Not Rng Is Nothing Then
         Rng.EntireRow.Copy Worksheets("Grad WRS Movement").Range("A" & lastrow2 + 1)
         Rng.EntireRow.Delete
      End If
    Application.ScreenUpdating = True

 

[cmschmitz24]

Now it works perfectly. Thanks, you rock!!

 

[Fluff]

You're welcome & thanks for the feedback.