Отфильтруйте рабочую книгу и скопируйте диапазон в другую рабочую книгу в следующей доступной ячейке

Question

Я хочу отфильтровать книгу, отыскивая все пустые записи в столбце E. Затем скопируйте диапазон в другую книгу в следующей доступной строке. Когда я запускаю свой код, я получаю сообщение об ошибке «ошибка времени выполнения» 1004 - метод PasteSpecial класса range не выполнен ?? Как мне отладить это, чтобы иметь возможность скопировать мой диапазон и вставить в другую рабочую книгу?

Я только начал изучать VBA и узнал большую часть того, что знаю из Google, и смотрел видео на YouTube. Я попытался изменить значение на пустое "", я попытался добавить 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`

ошибка выполнения 1004 - не удалось выполнить специальный метод класса диапазона

Answer 1

1. Зависит от версии Excel. Вы не можете сделать это в Excel 2003 и старше. Вы переводите 1000 строк в 1000 столбцов, старые Excels имеют только 256 столбцов.

2. Я немного исправил Ваш код, теперь будет работать в новейших версиях, начиная с 2007 года.

   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