Question

我有一个按钮，可以将源表中的某些列复制/粘贴到新表/表中，并且此方法可以正常工作，除非对源表进行了过滤。如果我以某种方式留下了一些过滤器，它将不会复制所有数据：（

我已经尝试了“ ShowAllData”的几种组合，但是它们全部都因相同的错误'9'OutOfScript而失败了……这是我的整个代码：

Sub Button1_Click()
    Dim row_last As Long
    Dim range_src As String
    Dim cols_src As Variant

    cols_src = Array("A", "B", "C", "D", "I", "R", "S", "T", "U")
    Sheets("TMP").Cells.Clear

    With Sheets("Validation by rules")
        ' Set lo = .ListObjects(1)
        ' lo.AutoFilter.ShowAllData
        ' Sheets("Validation by rules").ListObjects(1).AutoFilter.ShowAllData
        ' ActiveSheet.ListObjects(1).AutoFilter.ShowAllData
        row_last = .Cells(.Rows.Count, 1).End(xlUp).Row
        Dim i As Long
        For i = LBound(cols_src) To UBound(cols_src)
            ' MsgBox .Cells(1, cols_src(i))
            .Range(.Cells(1, cols_src(i)), .Cells(row_last, cols_src(i))).Copy Destination:=Sheets("TMP").Cells(1, i + 1)
        Next i
    End With
    MsgBox CStr(row_last) & " records copied"
    ThisWorkbook.RefreshAll
End Sub

关于我在做什么错的任何提示……谢谢！

Answer 1

首先，使用ListObject对象的ShowAutoFilter属性检查是否显示了自动筛选器，然后显示所有数据（如果处于筛选器模式）。

Dim lo As ListObject

With Sheets("Validation by rules")
    Set lo = .ListObjects(1)
    With lo
        If .ShowAutoFilter Then
            With .AutoFilter
                 If .FilterMode Then .ShowAllData
            End With
        End If
    End With
    'etc
    '
    '
    '
End With

Answer 2

您可以按以下方式简化复制/粘贴操作

Sub Button1_Click()
    Dim range_src As String

    Sheets("TMP").Cells.Clear
    With Sheets("Validation by rules")
        '.ShowAllData ' uncomment tgis line to copy/paste all data
        Intersect(.Range("A:D, I:I, R:U"), .Rows(1).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row)).Copy Destination:=Sheets("TMP").Cells(1, 1)
    End With
    ThisWorkbook.RefreshAll
End Sub

ShowAllData Excel宏以清除筛选器中的表给出了脚本错误9

2 个答案: