Home > database >  How do I copy a specific range of cells after I use AutoFilter in VBA?
How do I copy a specific range of cells after I use AutoFilter in VBA?

Time:02-02

I am having a little trouble figuring out how the AutoFilter function works in VBA. This line of code: Worksheets("my sheet").Range("A1").AutoFilter Field:=14, Criteria1:="my criteria" filters the worksheet in col 14 just fine like I want, but when I go to copy the first col using this snippet of code:

Dim LR As Long
LR = Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("my sheet").Range("A2:A" & LR).Copy

I then have the first header of the first col (A1) copied into my sheet I created, which is not what I want. I want to copy everything that is filtered BUT the header (A2 and down to the end of the filtered col).

I tried to separate the functions that create the sheets that I am copying the col's into, in case there was some issue when the sheets were being created, but that did not fix the issue. I did snag this snippet of code from the internet:

Dim LR As Long
LR = Cells(Rows.Count, 1).End(xlUp).Row

But to my knowledge, that shouldn't be the issue, because my code does work if I run the macro again (twice), once the new sheets have been created and they have been formatted (just some text in cells A1 and B1 and some formatting of those cells). Any insight would be appreciated!

CodePudding user response:

Set the range of filtered data

Set Rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible)

CodePudding user response:

Copy First Column of Filtered Range

  • In the Immediate window Ctrl G, see the relevant addresses of the ranges.
Option Explicit

Sub CopyFirstColumnOfFilteredRange()

    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Sheets("Sheet1")
    If sws.AutoFilterMode Then sws.AutoFilterMode = False ' turn off AutoFilter
    
    Dim srg As Range: Set srg = sws.Range("A1").CurrentRegion ' table range
    Dim sdrg As Range: ' data range (no headers): first column ', 1'
    Set sdrg = srg.Resize(srg.Rows.Count - 1, 1).Offset(1)
    
    Debug.Print srg.Address
    Debug.Print sdrg.Address
    
    srg.AutoFilter 14, "My Criteria"
    
    Dim sdvrg As Range ' visible data range (no headers)
    On Error Resume Next ' to prevent error if no cells
        Set sdvrg = sdrg.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    sws.AutoFilterMode = False ' turn off AutoFilter
    
    If sdvrg Is Nothing Then
        MsgBox "No filtered rows.", vbExclamation
        Exit Sub
    End If
    
    Debug.Print sdvrg.Address

    Dim dws As Worksheet: Set dws = wb.Sheets("Sheet2")
    Dim dfCell As Range: Set dfCell = dws.Range("A2")
    
    sdvrg.Copy dfCell

    MsgBox "Filtered column copied.", vbInformation

End Sub
  • Related