仅复制没有高级过滤器的过滤数据并将原始过滤器保留在原始表上答案

【问题标题】：copying only filtered data without advanced filter and keeping the original filter on the original table仅复制没有高级过滤器的过滤数据并将原始过滤器保留在原始表上
【发布时间】：2021-05-07 18:24:30
【问题描述】：

我有一个代码，可以将不同工作簿中的数据复制到一个数组中，然后将该数据传输到一个表中在我要复制到的工作簿上，我只想看到过滤后的内容有人有建议吗？

我注释掉了偏移量，因为代码不起作用我需要偏移量才能不复制标题行

    Sub readingarray()
    
    
    Dim table_list_object As ListObject
    Dim table_object_row As ListRow
    Dim arr As Variant
    Dim tbl As Range
    
    Set tbl = Workbooks("test.xlsm").Worksheets("shibuz").Range("T4").CurrentRegion.SpecialCells(xlCellTypeVisible)
    'arr = tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count)
    arr = tbl
    
    Set table_list_object = Workbooks("shibuzim 2 updated.xlsm").Worksheets("shibuz").ListObjects("LeaveTracker")
    Set table_object_row = table_list_object.ListRows.Add
    
    Dim rowcount As Long, columncount As Long
     rowcount = UBound(arr, 1)
     columncount = UBound(arr, 2)
    table_object_row.Range(1, 1).Resize(rowcount, columncount).Value = arr
    End Sub

【问题讨论】：

我现在设置的方式它只复制表格中的标题行

标签： arrays excel vba copy

【解决方案1】：

解决了，希望对你有帮助

Option Explicit


Sub readingarray()
Application.DisplayAlerts = False

Dim table_list_object As ListObject
Dim table_object_row As ListRow
Dim arr
Dim Itm
Dim rng As Range
Dim stringarray As Variant
Dim rowcount As Long, columncount As Long
stringarray = Array("test.xlsm", "test 2.xlsm")
 On Error Resume Next
    For Each Itm In stringarray
       
    
        arr = GetArrayFromFilteredRange(Workbooks(Itm).Worksheets("shibuz").ListObjects("LeaveTracker").DataBodyRange.SpecialCells(xlCellTypeVisible))
         Set table_list_object = Workbooks("shibuzim 2 updated.xlsm").Worksheets("shibuz").ListObjects("LeaveTracker")
         Set table_object_row = table_list_object.ListRows.Add

    
        rowcount = UBound(arr, 1)
        columncount = UBound(arr, 2)
        table_object_row.Range(1, 1).Resize(rowcount - 1, columncount - 1).Value = arr
    Next Itm
    
  On Error GoTo 0
End Sub

Function GetArrayFromFilteredRange(rng As Range) As Variant
    Dim arr As Variant
    
   helper.Cells.Clear
    rng.Copy helper.Range("A1")
    arr = helper.UsedRange.Value
    
    GetArrayFromFilteredRange = arr
End Function

【讨论】：