Copy filtered data to sheet 2
 

The filter works & it goes to the available cell in sheet2 but doesn't paste
the filtered data.

Any ideas?


'Option Explicit
Function FilterAndCopy(rng As Range, Choice As String)

Dim FiltRng As Range
Worksheets("sheet2").Select
Dim a As Integer
a = 0
Do
a = a + 1
Loop Until ActiveCell.Offset(a, 0) = ""
ActiveCell.Offset(a, 0).Activate
ActiveCell = FiltRng


rng.AutoFilter Field:=5, Criteria1:=Choice
On Error Resume Next
Set FiltRng = rng.SpecialCells(xlCellTypeVisible).EntireRow
On Error GoTo 0


Worksheets("Sheet2").Select
FiltRng.Copy Worksheets("Sheet2").ActiveCell
Range("A1").Select
Set FiltRng = Nothing
End Function


Other code on the form button is
Private Sub UserForm_Click()
Option Explicit

Private Sub CommandButton1_Click()
Dim rng As Range

'Set Error Handling
On Error GoTo ws_exit:
Application.EnableEvents = False
'Set Range
Set rng = ActiveSheet.UsedRange
'Cancel if no value entered in textbox
If TextBox1.Value = "" Then GoTo ws_exit:
'Call function Filterandcopy
FilterAndCopy rng, TextBox1.Value
rng.AutoFilter
'Exit sub
ws_exit:
Set rng = Nothing
Application.EnableEvents = True
Unload Me
End Sub

Copy filtered data to sheet 2
 

Hi,

This code below copies an autofiltered list to another sheet:
---
Set r = ws.Range("A1").CurrentRegion
With r
.AutoFilter 13, "NZzzM", xlAnd
Set rv = .Offset(1).SpecialCells(xlCellTypeVisible)
End With
rv.Copy ws2.Range("A1")
---
Pascal Baro