Specific columns from auto filter range - VBA

[Millsio88]

Is there a way to only copy certain columns from an auto filter?



With the below example the active sheet has 8 columns of data G, L, P, R, S, T, W, AB (other columns have been hidden)



When I copy the data, I don’t want to copy column W & AB so that only 6 columns of data will be moved to sheet 1.



I get lost on offset and resize and the answer might be as simple as changing a figure but can’t seem to get it to work. The below code works other than not copying W & AB.



Sub NewCopy()



With ActiveSheet.AutoFilter.Range

.Offset(1, 0).Resize(.Rows.Count - 1).Copy

Sheets(1).Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

:=False, Transpose:=False

End With



End Sub

 

[Peter_SSs]

What columns, including hidden ones form the AutoFilter range? That is, if all columns were unhidden, which columns would contain the AutoFilter drop-down arrows?

 

[Millsio88]

Columns go from A - AI however there is code that hides all apart from the 8 states above.

 

[Peter_SSs]

Columns go from A - AI however there is code that hides all apart from the 8 states above.

Thanks. Try this. (Like your code, it does assume at least one row of visible data below the AutoFilter headings or you will get some unwanted results.)

Sub NewCopy_v2()
  With ActiveSheet.AutoFilter.Range
    .Offset(1, 6).Resize(.Rows.Count - 1, 14).Copy
    Sheets(1).Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
  End With
End Sub

BTW, When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details.

 

[Peter_SSs]

it does assume at least one row of visible data below the AutoFilter headings or you will get some unwanted results

If it might be possible that a filter was applied that resulted in all rows (except heading) being hidden, then you could add this safety check

Sub NewCopy_v3()
  With ActiveSheet.AutoFilter.Range
    If .Columns(7).SpecialCells(xlVisible).Count > 1 Then
      .Offset(1, 6).Resize(.Rows.Count - 1, 14).Copy
      Sheets(1).Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      Application.CutCopyMode = False
    End If
  End With
End Sub

 

[Millsio88]

If it might be possible that a filter was applied that resulted in all rows (except heading) being hidden, then you could add this safety check

Sub NewCopy_v3()
  With ActiveSheet.AutoFilter.Range
    If .Columns(7).SpecialCells(xlVisible).Count > 1 Then
      .Offset(1, 6).Resize(.Rows.Count - 1, 14).Copy
      Sheets(1).Range("B" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
      Application.CutCopyMode = False
    End If
  End With
End Sub

Thanks so much this works perfectly. Will take the feedback on board for the codes tags on my phone and been a while since in Mr Excel.

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.