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

请注意与您的代码有关的以下几点

a）x.Sheets.ListObjects不能识别变量及其变量正确关联，会导致编译器错误，而 x.ActiveSheet.ListObjects是正确的。
b）重复两次过滤行是无法理解的。
c）您必须使用visibleCells属性复制已过滤的单元格中的单元格。
d）您必须激活要处理的工作表，或者与...一起使用。以结构结尾。以后一个比较可取方法。
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帖子后面关注。

What is the reason not to use select *?

Why is SELECT * considered harmful?

最后，我选择了基于数组的方法，我认为这可能会带来更好且一致的结果。

尝试一下：

    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

编辑根据OP在2019年7月3日的评论添加了示例数据和结果的屏幕快照，以供OP指导。

从一个工作簿复制到另一个包括表

1 个答案: