Copy and Paste Filtered Data

**r5swank** · 10-24-2012, 09:43 AM

I need to copy all the filtered data only from "Sheet1" over to "Members" currently I am just having it select and copy / paste, but this takes a great deal of time. I've looked through some forums to try and figure this out, but can't seem to locate a helpful answer, any ideas?

This is what I currently have:

Sheets("Sheet1").Select
        Range("A1").Select
    Selection.AutoFilter

    ActiveSheet.Range("$A$1:$AC$5543").AutoFilter Field:=14, Criteria1:="YES"
    Cells.Select
    Range("E1").Activate
    Selection.Copy
    Sheets("Members").Select
    Cells.Select
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    ActiveSheet.Range("$A$1:$AC$5543").AutoFilter Field:=14
    Range("E2").Select
    Selection.End(xlToLeft).Select
    Application.CutCopyMode = False

Thank you!

**HaHoBe** · 10-24-2012, 10:48 AM

Hi, r5swank,

please use Code-Tags for displaying the contents. Maybe this is slightly faster:

With Sheets("Sheet1")
  .Range("A1").AutoFilter
  With .Range("A1").CurrentRegion
      .AutoFilter Field:=14, Criteria1:="YES"
      .SpecialCells(xlCellTypeVisible).Copy Sheets("Members").Range("A1")
      .AutoFilter
  End With
End With

Ciao,
Holger

**JOHN H. DAVIS** · 10-24-2012, 11:06 AM

Do either of these help any?

Sub r5swank2()

Application.ScreenUpdating = False

Sheets("Sheet1").Select
Range("A1").Select
Selection.AutoFilter

ActiveSheet.Range("$A$1:$AC$5543").AutoFilter Field:=14, Criteria1:="YES"
Cells.Select
Range("E1").Activate
Selection.Copy
Sheets("Members").Select
Cells.Select
ActiveSheet.Paste
Sheets("Sheet1").Select
ActiveSheet.Range("$A$1:$AC$5543").AutoFilter Field:=14
Range("E2").Select
Selection.End(xlToLeft).Select
Application.CutCopyMode = False

Application.ScreenUpdating = True

End Sub

Not sure this one does what you want so try on a copy first.


Sub r5swank()

Application.ScreenUpdating = False

Sheets("Sheet1").Activate

    With Range("$A$1:$AC$5543")
    
        .AutoFilter Field:=14, Criteria1:="YES"
        .SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Members").Range("A" & Rows.Count).End(3)(2)
        
    End With
    
ActiveSheet.AutoFilterMode = False

Application.ScreenUpdating = True


End Sub