excel vba – 在自动筛选器后select除标题以外的所有过滤行

我试图写一个macros来做以下事情：

• 从Sheet1中看到我input的数据的A列;
• 当我在A列的单元格中写入内容时，使用该值来过滤Sheet2;
• 在完成过滤之后，即使有多个值，也可以将除第二个页面的列标题之外的所有内容复制到第一个页面中。

我试着写这个：

Private Sub Worksheet_Change(ByVal Target As Range) Dim KeyCells As Range Set KeyCells = Range("A:A") If Not Application.Intersect(KeyCells, Range(Target.Address)) _ Is Nothing Then copy_filter Target End If End Sub Sub copy_filter(Changed) Set sh = Worksheets("Sheet2") sh.Select sh.Range("$A$1:$L$5943") _ .AutoFilter Field:=3, _ Criteria1:="=" & Changed.Value, _ VisibleDropDown:=False Set rang = sh.Range("$A$1:$L$5943") _ .SpecialCells(xlCellTypeVisible) rang.Offset(0, 0).Select Selection.Copy Worksheets("Sheet1").Select Worksheets("Sheet1").Range(Changed.Address).Offset(0, 1).Select Selection.PasteSpecial Paste:=xlPasteValues sh.Range("$A$1:$L$5943").AutoFilter Application.CutCopyMode = False End Sub 

但是，当我复制select时，标题行也被复制，但是使用.Offset（1,0）剪切标题和另外1行，并且不考虑filter没有返回结果的情况。

我怎样才能select每个过滤行除了标题？

Answer 1

使用sh.UsedRange会给你一个dynamic的范围。 在哪里， sh.Range("$A$1:$L$5943")将不会缩小，并与您的数据集匹配。
我们可以像这样修剪标题行：

  Set rang = sh.UsedRange.Offset(1, 0) Set rang = rang.Resize(rang.Rows.Count - 1) 

但是SpecialCells(xlCellTypeVisible)会抛出一个No cells were found. 错误，如果没有数据返回。 所以我们必须像这样捕捉错误：

 On Error Resume Next Set rang = rang.SpecialCells(xlCellTypeVisible) If Err.Number = 0 Then End If On Error GoTo 0 

     Sub copy_filter（已更改）
        昏暗的响起作为范围

        设置sh =工作表（“Sheet2”）

         sh.UsedRange.AutoFilter字段：= 3，_
                                 Criteria1：=“=”＆Changed.Value，_
                                 VisibleDropDown：=假


        设置rang = sh.UsedRange.Offset（1，0）
        设置rang = rang.Resize（rang.Rows.Count  -  1）

        在错误恢复下一步
        设置rang = rang.SpecialCells（xlCellTypeVisible）
        如果Err.Number = 0那么
             rang.Copy
            工作表（“Sheet1”）。范围（Changed.Address）.Offset（0，1）.PasteSpecial粘贴：= xlPasteValues
        万一

        在错误转到0

         sh.Cells.AutoFilter

         Application.CutCopyMode = False


    结束小组