PasteSpecial doesn't work

[Bandito1]

Hello all,

Found this code on this form

It copies the row where in column AH is "shipped" to the sheet Backup.
Now it copies also the formulies. I want only values.

Tried to change this line;

ActiveSheet.Paste

to

ActiveSheet.PasteSpecial xlPasteValues

But it error; PasteSpecial method of Worksheet class failed

What am i doing wrong?

Sub Copy()
Dim i As Long
Dim lngLastRow As Long, lngPasteRow As Long

lngLastRow = Sheets("Sheet1").Range("D65535").End(xlUp).Row

lngPasteRow = 4

For i = 4 To lngLastRow
    If Sheets("Sheet1").Range("AH" & i).Value = "Shipped" Then
        Sheets("Sheet1").Select
        Range("A" & i & ":IV" & i).Copy
        Sheets("Backup").Select
        Range("A" & lngPasteRow & ":IV" & lngPasteRow).Select
        ActiveSheet.Paste
        lngPasteRow = lngPasteRow + 1
    End If
Next i

End Sub

 

[Jeffrey Mahoney]

Please try this.

Sub Copy()
  Dim i As Long
  Dim lngLastRow As Long, lngPasteRow As Long
  Dim Sht1 As Worksheet
  Dim BUSht As Worksheet
  Dim Rng As Range
  Dim OutR As Range
  
  Set Sht1 = Sheets("Sheet1")
  Set BUSht = Sheets("Backup")
  lngLastRow = Sht1.Range("D65535").End(xlUp).Row
  
  lngPasteRow = 4
  
  For i = 4 To lngLastRow
      If Sht1.Range("AH" & i).Value = "Shipped" Then
          'Sheets("Sheet1").Select
          Set Rng = Range("A" & i & ":IV" & i)
          'Sheets("Backup").Select
          Set OutR = Range("A" & lngPasteRow & ":IV" & lngPasteRow)
          OutR.Value = Rng.Value
          lngPasteRow = lngPasteRow + 1
      End If
  Next i

End Sub

 

[Bandito1]

It worked, thanks

The comments shouldn't be comments in your code otherwise it doesn't work

When i wanna copy the data into another workbook i can change the Set BUSht to the path of the other workbook?

 

[jolivanes]

No worries about "PasteSpecial, ScreenUpdating or whatever.

Sub My_Preferred_Way_When_Looping()
Dim c As Range
Dim lr As Long
Dim wb1 As Workbook, wb2 As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet
Set wb1 = ThisWorkbook
On Error Resume Next
Set wb2 = Workbooks("C:\Whatever Folder\Whatever Workbook.xlsm")    '<---- Change as required
If Err Then Set wb2 = Workbooks.Open("C:\Whatever Folder\Whatever Workbook.xlsm")
On Error GoTo 0

Set sh1 = wb1.Sheets("Sheet1")    '<---- Change as required
Set sh2 = wb2.Sheets("Backup")    '<---- Change as required

lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
    For Each c In sh1.Range("AH1:AH" & lr)
        If c.Value = "Shipped" Then
            sh2.Cells(Rows.Count, 34).End(xlUp).Offset(1, -33).Resize(, 256).Value = sh1.Cells(c.Row, 1).Resize(, 256).Value
        End If
    Next c
End Sub

Maybe Jeffrey has a better/shorter version though.

If you have a very large Range, AutoFilter might be better/faster.

 

[Jeffrey Mahoney]

Please try this.

Sub Copy()
  Dim i As Long
  Dim lngLastRow As Long, lngPasteRow As Long
  Dim Sht1 As Worksheet
  Dim BUSht As Worksheet
  Dim Rng As Range
  Dim OutR As Range
 
  Set Sht1 = Sheets("Sheet1")
  Set BUSht = Sheets("Backup")
  lngLastRow = Sht1.Range("D65535").End(xlUp).Row
 
  lngPasteRow = 4
 
  For i = 4 To lngLastRow
      If Sht1.Range("AH" & i).Value = "Shipped" Then
          'Sheets("Sheet1").Select
          Set Rng = Range("A" & i & ":IV" & i)
          'Sheets("Backup").Select
          Set OutR = Range("A" & lngPasteRow & ":IV" & lngPasteRow)
          OutR.Value = Rng.Value
          lngPasteRow = lngPasteRow + 1
      End If
  Next i

End Sub

Change this code:
Set OutR = busht.Range("A" & lngPasteRow & ":IV" & lngPasteRow)

 

[Jeffrey Mahoney]

It worked, thanks

The comments shouldn't be comments in your code otherwise it doesn't work

When i wanna copy the data into another workbook i can change the Set BUSht to the path of the other workbook?

Yes, you can change the sheet reference. With a commented sections out and the code change that I gave you that old code should work