将过滤后的数据复制到新工作簿时出现问题

Question

我正在使用此代码筛选数据库，然后将生成的筛选数据复制到第二个工作簿中的工作表。

 With ws_sched
    Set srng = .Range(.Cells(1, 1), .Cells(.Range("A" & Rows.count).End(xlUp).row, .Cells(1, Columns.count).End(xlToLeft).Column))
        srng.AutoFilter _
        Field:=2, _
        Criteria1:=trgt_date, _
        VisibleDropDown:=False
    'srng.SpecialCells(xlCellTypeVisible).Copy ws_data.Range("A1")
    srng.Copy
    ws_data.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    If .AutoFilterMode Then .AutoFilterMode = False
End With

'ws_sched' 是过滤后的原始数据库。 'ws_data' 是第二个工作簿中的目标工作表。

过滤器有效，但复制和粘贴仅留下源数据库的 header 行（过滤数据的许多行中的第一行）。

有谁能帮我解决为什么我过滤后的数据没有传输的问题？

以上代码反映了我根据我对 Thiago 建议的理解对我的原始代码所做的更改。这仍然只复制 header 行，没有过滤数据。

Answer 1

尝试对复制的数据进行特殊粘贴，而不是像现在这样通知目的地

Answer 2

一定是你在 ws_sched 列 A 中只有 header，给你行 depth of srng ，因此设置为 one-row range

你可以通过在 Set srng =...

之后添加一些 Msgbox srng.Address 语句来证明这一点

所以你有两种方法：

选择不同的列从

中获取数据行深度

在这种情况下，我会选择 "B" 列，因为这是您似乎想要过滤的列

Set srng = .Range(.Cells(1, 1), .Cells(.Range("B" & Rows.Count).End(xlUp).row, .Cells(1, Columns.Count).End(xlToLeft).Column))

通过UsedRange

推断数据行depth

在这种情况下，您只需更改 copying 语句如下：

Intersect(.UsedRange, .Columns(2).EntireRow, srng.EntireColumn).SpecialCells(xlCellTypeVisible).Copy ws_data.Range("A1")

最后，您可能会遇到 A 列完全空白的情况，即甚至没有 header。在这种情况下，您应该将所有代码转移到从 B

列开始

        Set srng = .Range(.Cells(1, 2), .Cells(.Range("B" & Rows.Count).End(xlUp).row, .Cells(1, Columns.Count).End(xlToLeft).Column))
            srng.AutoFilter _
            Field:=1, _
            Criteria1:=">=2", _
            VisibleDropDown:=False
        srng.SpecialCells(xlCellTypeVisible).Copy ws_data.Range("A1")

Answer 3

此 VBA 代码将帮助您将过滤后的数据放入其他 Sheet。

子 copy_filtered_data()

Worksheets("Data Input").UsedRange.SpecialCells(xlCellTypeVisible).Copy _ Destination:=Worksheets("Results").Range("A1")

结束子

注意：您也可以将此代码与自动过滤器代码一起使用。

将过滤后的数据复制到新工作簿时出现问题

Problems Copying Filtered Data To New Workbook

excel

vba

copy

paste