Excel's favorite RT error - PasteSpecial method of Range Class failed. grrr

[jim may]

I'm trying to Move a Row of Data to ANOTHER WORKSHEET (Same WB) if Column 8 of each row included the text "closed". Once the First such row is Cut and Deleted the code is taking me to Sheet2 but bombing after running the code line IN RED (below). Current getting the 1004 error. What's missing/wrong? TIA, Jim

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Columns(8), Target) Is Nothing Then Exit Sub
Dim i As Long
Application.EnableEvents = False
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
    If Cells(i, 8).Value = "closed" Then
        Cells(i, 8).EntireRow.Cut
        Cells(i, 8).EntireRow.Delete
        With Worksheets("Sheet2")
            NBR = .Range("A" & Rows.Count).End(xlUp).Row + 1
            .Range("A" & NBR).PasteSpecial Paste:=xlPasteValues
        
      
        End With
    End If
Next i
Application.EnableEvents = True
End Sub

 

[steve the fish]

Try doing a cut and paste special manually. You cant. You will also struggle if you delete the row between a copy and a paste.

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Columns(8), Target) Is Nothing Then Exit Sub
    Dim i As Long
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    LR = Range("A" & Rows.Count).End(xlUp).Row
    For i = LR To 2 Step -1
        If Cells(i, 8).Value = "closed" Then
            Cells(i, 8).EntireRow.Copy
            With Worksheets("Sheet2")
                NBR = .Range("A" & Rows.Count).End(xlUp).Row + 1
                .Range("A" & NBR).PasteSpecial Paste:=xlPasteValues
            End With
            Cells(i, 8).EntireRow.Delete
        End If
    Next i
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[Richard U]

try this instead.

It skips using the paste altogheter.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Columns(8), Target) Is Nothing Then Exit Sub
Dim i As Long
Application.EnableEvents = False
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
    If Cells(i, 8).Value = "closed" Then
         With Worksheets("Sheet2")
            NBR = .Range("A" & Rows.Count).End(xlUp).Row + 1
            .Rows(NBR).EntireRow.Value = ActiveSheet.Rows(i).EntireRow.Value
         End With
         Rows(i).EntireRow.Delete
    End If
Next i
Application.EnableEvents = True
End Sub

 

[mumps]

On second thought, do you really need to loop through all the rows? If you are simply entering "closed" in column H and you want that row cut to Sheet2 then this would do it:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Columns(8), Target) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    If Target = "closed" Then
        Target.EntireRow.Copy
        Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
        Target.EntireRow.Delete
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

 

[Rick Rothstein]

Does this event code work for you...

[table="width: 500"]
[tr]
	[td]Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Columns(8), Target) Is Nothing Then Exit Sub
  Dim LR As Long, R As Long
  Application.EnableEvents = False
  LR = Range("A" & Rows.Count).End(xlUp).Row
  For R = LR To 2 Step -1
    If LCase(Cells(R, "H").Value) = "closed" Then
      Rows(R).Cut Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1)
      Rows(R).Delete
    End If
  Next
  Application.EnableEvents = True
End Sub[/td]
[/tr]
[/table]

 

[jim may]

Thanks to all you guys... I now see the light you have provided!! Jim