如何从 Excel VBA 中自动过滤的给定范围复制某些特定列？答案

【问题标题】：How do I copy some specific columns from a given range which is auto filtered in Excel VBA?如何从 Excel VBA 中自动过滤的给定范围复制某些特定列？
【发布时间】：2017-07-20 21:16:21
【问题描述】：

我在 excel 中有一个 71 列的数据集。在将源工作表（RAS(Offshore)）上的自动过滤器应用到目标工作表（Dst）后，我只需要从中复制 7 列。在使用 Excel VBA 将 RAS(Offshore) 上的过滤器应用到 Dst 之后，我需要复制的列是 C,D,G,M,AH,BD,BP。

我成功地应用了自动过滤器并复制了整个范围，但我无法提取如上所述的特定列。请帮忙。

    FilterCriteria = InputBox("What text do you want to filter on?", _
                           "Enter the filter item.")

    My_Range.AutoFilter Field:=34, Criteria1:="=" & FilterCriteria
    My_Range.AutoFilter Field:=7, Criteria1:="=Freshers/TSS"

    With My_Range.Parent.AutoFilter.Range

    Set rng = .Offset(1, 0).Resize(.Rows.Count, .Columns.Count) _
                  .SpecialCells(xlCellTypeVisible)

        If Not rng Is Nothing Then
            'Copy and paste the cells into DestSh below the existing data
            rng.Copy
            With DestSh.Range("A" & LastRow(DestSh) + 1)
                .PasteSpecial Paste:=8
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With
          End If

请建议我如何从rng 对象复制C,D,G,M,AH,BD,BP。

【问题讨论】：

您可以使用Union 组合所需的列并复制结果，或者复制整个批次然后删除您不需要的列。
@SJR 你能建议怎么做吗？
Union(Range("C1:C" & intLastRow), Range("D1:D" & intLastRow),...).SpecialCells(xlCellTypeVisible).Copy

标签： vba excel

【解决方案1】：

您可以使用Intersect 将副本限制为您的特定列（请参见下面的代码）。另请注意，在应用.Copy 时，您不需要使用.SpecialCells(xlCellTypeVisible)，因为Copy 方法会自动仅应用于可见单元格。

试试这个方法：

With My_Range
  .AutoFilter Field:=34, Criteria1:="=" & FilterCriteria
  .AutoFilter Field:=7, Criteria1:="=Freshers/TSS"
  Intersect(.Offset(1), .Parent.Range("C:C,D:D,G:G,M:M,AH:AH,BD:BD,BP:BP")).Copy

  With DestSh.Range("A" & lastrow(DestSh) + 1)
    .PasteSpecial xlPasteColumnWidths
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteFormats
  End With
  .AutoFilter
End With

【讨论】：

【解决方案2】：

如果您已过滤范围，则可以通过以下方式使用复制模式：使用语句 xlCellTypeVisible，您只需将过滤后的值复制到新工作表。

Dim intLastRow as Integer
With Worksheets("Tabelle1")
intLastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
end with
    Worksheets("Tabelle1").Range("C1:C" & intLastRow).SpecialCells(xlCellTypeVisible).Copy _
                            Destination:=Worksheets("Tabelle2").Cells(1, 1)


    Worksheets("Tabelle1").Range("D1:D" & intLastRow).SpecialCells(xlCellTypeVisible).Copy _
                            Destination:=Worksheets("Tabelle2").Cells(1, 2)

等等。您也可以将其插入循环中。希望对你有帮助

【讨论】：