Копировать из одной рабочей книги в другую, включая таблицы

Question

Итак, я пытаюсь скопировать данные из одной рабочей книги в другую. Лист, в котором находятся данные, находится в форме таблицы, но когда я пробую приведенный ниже код, он не работает. Перед копированием сначала выполняется фильтрация, а затем копируются данные.

Sub Details()
Dim x As Workbook
Dim y As Workbook

'## Open both workbooks first:
Set x = Workbooks("C:\Users\user\Desktop\mi\Extracts.xlsm")
Set y = Workbooks("C:\Users\user\Desktop\mi\Outstanding.xlsm")


    x.Sheets.ListObjects("FIdetails").Range.AutoFilter Field:=1

    x.Sheets.ListObjects("FIdetails").Range.AutoFilter Field:=1, Criteria1:= _
        "Magnesium"

        lastCol = ActiveSheet.Range("b4").End(xlToRight).Column
    Lastrow = ActiveSheet.Cells(4, 1).End(xlDown).Row
    ActiveSheet.Range("b4", ActiveSheet.Cells(Lastrow, lastCol)).Copy

'paste to y worksheet:
y.Sheets("Details").Range("A2").Paste


End Sub

Любая помощь будет большой благодарностью.

Answer 1

Обратите внимание на следующие пункты относительно вашего кода

• а) x.Sheets.ListObjects не идентифицирует переменные и их ассоциация правильно и даст ошибку компилятора, тогда как x.ActiveSheet.ListObjects правильно.

• б) Повторение строки фильтра дважды не понятно.

• в) Вы должны использовать свойство visibleCells для копирования отфильтрованных ячейки в вашем методе.

• г) Вы должны либо активировать лист для обработки, либо использовать с ... конец структуры. Позже один предпочтительнее подход.

• e) Для очистки фильтра используйте свойство ShowAlldata.

Я записал макрос, чтобы продемонстрировать его потенциал.

  Sub Macro()
'
' Macro6 Macro
'

'
    Cells.Select
    Application.Goto Reference:="FIdetails"
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveSheet.ListObjects("FIdetails").Range.AutoFilter Field:=1, Criteria1:= _
        "magnesium"
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    Windows("Outstanding.xlsm").Activate
    Range("A2").Select
    ActiveSheet.Paste
    Windows("Extracts.xlsm").Activate
    Cells.Select
    Application.CutCopyMode = False
    ActiveSheet.ShowAllData
End Sub

Впоследствии, если вы запускаете программу, она генерирует ошибку, особенно в строке Application.Goto Reference:="FIdetails", а также не является надежной в производительности. Кроме того, он использует «Выбор», который желательно избегать, имея в виду следующие сообщения SO.

По какой причине не использовать select *?

Почему SELECT * считается вредным?

Наконец, я выбрал подход на основе массива, который, я думаю, может дать лучшие и последовательные результаты.

Попробуйте это:

    Sub Details()
    Dim Results As Variant, tmp As Variant
    Dim i As Long, j As Long
    Dim CriteriaCol As Long, ResultCount As Long
    Dim Criteria As String

    Criteria = "Magnesium"
    CriteriaCol = 1

    With Sheet1.ListObjects("FIdetails")
        tmp = .DataBodyRange
    End With

    ReDim Results(LBound(tmp, 2) To UBound(tmp, 2), LBound(tmp, 1) To UBound(tmp, 1))
    For i = LBound(tmp, 1) To UBound(tmp, 1)
        If UCase(tmp(i, CriteriaCol)) = UCase(Criteria) Then
            ResultCount = ResultCount + 1
            j = LBound(tmp, 2) - 1
            Do
                j = j + 1
                Results(j, ResultCount) = tmp(i, j)
            Loop Until j = UBound(tmp, 2)
        End If
    Next i
    ReDim Preserve Results(LBound(Results, 1) To UBound(Results, 1), LBound(Results, 1) To ResultCount)
    With Workbooks("Outstanding.xlsm").Sheets("Details")
        .Cells(2, 1).Resize(UBound(Results, 2), UBound(Results, 1)) = Application.Transpose(Results)
    End With
End Sub

EDIT Добавлены скриншоты образцов данных и результатов для руководства ОП на основе его комментариев от 07-03-2019.