如何复制给定范围内的某些特定列，该范围在Excel VBA中会自动过滤？

Question

I have a data set in excel of 71 columns. I need to copy only 7 columns from them after applying auto filter on the source sheet( RAS(Offshore) ) to the destination sheet( Dst ). The columns that I need to copy are C,D,G,M,AH,BD,BP after applying the filters on RAS(Offshore) to Dst , using Excel VBA.

I am successful in applying the auto filters and copying the whole range, but I am not able to extract particular columns as stated above. Please help.

    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

Please suggest how can I copy C,D,G,M,AH,BD,BP from rng object.

Answer 1

You can use Intersect to limit the copy to your specific columns (see code below). also notice that when applying .Copy , you dont need to use .SpecialCells(xlCellTypeVisible) because the Copy method automatically applies to visible cells only.

Try it this way:

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

Answer 2

If you have filterd the range, you could use the Copy mode this way: With the statement xlCellTypeVisible you only copy the Filterd Values to the new Sheet.

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)

and so on. You can insert this in a Loop aswell. Hope this will help you