Filter workbook and copy range into another workbook at next available cell

Question

I want to filter workbook by looking for all blank entries in column E. Then copy range into another workbook at the next available row. When I run my code I get an error 'run time error' 1004 - PasteSpecial method of range class failed?? How would I debug this to be able to copy my range and paste into other workbook?

I have only just started learning VBA and learned most of what I know from google and watching youtube videos. I have tried to change the value for blank "", I have tried to add application.cutcopymode false

Sub MoveUnworkedtoDB()

`Dim wbk As Workbook
 Dim sh As Worksheet 
 Dim Lastrow As Long


' Open worksheet 1 and move unworked back to database

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  Application.DisplayAlerts = False

  Set wbk = Workbooks.Open(Filename:= _
      "Workbook1")

  Set sh = wbk.Sheets("sheet1")

    'Clear any existing filters
  On Error Resume Next
    sh.ShowAllData
  On Error GoTo 0

  'Apply Filter
  sh.Range("A1:E9").AutoFilter Field:=5, Criteria1:=""

  'copy Range
  Application.DisplayAlerts = False
    sh.Range("B2:e1000").SpecialCells(xlCellTypeVisible).Copy
  Application.DisplayAlerts = True

   'Clear Filter
  On Error Resume Next
    sh.ShowAllData
  On Error GoTo 0

  Set wbk = Workbooks.Open(Filename:= _
    "workbook2")

 Set sh = wbk.Sheets("sheet1")

    Lastrow = Range("A65536").End(xlUp).row

    Sheets("sheet1").Activate
    Cells(Lastrow + 1, 1).PasteSpecial Paste:=xlPasteValues, 
Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=True
  Application.CutCopyMode = False

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True

End Sub`

runtime error 1004 - pastespecial method of range class failed

barneyos barneyos · Accepted Answer · 2019-10-26T22:46:23

Depends on Excel version. You can't do this in Excel 2003 and older. You transpose 1000 rows to 1000 columns, old Excels have 256 columns only.

I corrected a bit Your code, now will work in newest versions, from 2007 up.

Sub MoveUnworkedtoDB()

Dim wbk As Workbook
Dim sh As Worksheet
Dim Lastrow As Long
Dim wbk2 As Workbook
Dim sh2 As Worksheet


' Open worksheet 1 and move unworked back to database

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

Set wbk = Workbooks.Open(Filename:="C:\temp\A.xlsx")

Set sh = wbk.Sheets(1)

'Clear any existing filters
On Error Resume Next
sh.ShowAllData
On Error GoTo 0

'Apply Filter
sh.Range("A1:E9").AutoFilter Field:=5, Criteria1:=""

'copy Range
Application.DisplayAlerts = False
'sh.Range("B2:e1000").SpecialCells(xlCellTypeVisible).Copy
Application.DisplayAlerts = True

'Clear Filter
On Error Resume Next
sh.ShowAllData
On Error GoTo 0

Set wbk2 = Workbooks.Open(Filename:="C:\temp\B.xlsx")
Set sh2 = wbk2.Sheets(1)

With sh2
    Lastrow = .Range("A65536").End(xlUp).Row
    sh.Range("B2:e1000").SpecialCells(xlCellTypeVisible).Copy
    .Cells(Lastrow + 1, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
End With

Application.CutCopyMode = False

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True

End Sub

Filter workbook and copy range into another workbook at next available cell

1 Answers