Autofilter problem

[jgalas]

Hi everyone,

For a project I'm doing I have a worksheet("Registos") that autofilters a range of datas according to values of 2 particular range("BF2") and range(Q13") within the worksheet("PrintDupla"). Once the autofilter is complete, the resulting row (only one is possible) is copied to range ("A1") of worksheet ("Registos").

Problem: I have figured how to do the autofilter, but i do not know how to copie this row to range("A1").

Here is the code:

Sub Filtrar()
'
' Filtrar Macro em 26-09-2011 por Galas
'
    Range("A4:AE4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$4:$AE$7").AutoFilter Field:=1, Criteria1:=Sheets("PrintDupla").Range("BF2").Text
    ActiveSheet.Range("$A$4:$AE$7").AutoFilter Field:=2, Criteria1:=Sheets("PrintDupla").Range("Q13").Text
End Sub

Please Help me with the code
Thank you in advance...

 

[jgalas]

I have figured the code...
I put it in the worksheet("REgistos")

Sub Filtrar()
'
' Filtrar Macro em 26-09-2011 por Galas
'
    Application.Visible = False
    Sheets("Registo").Activate
    Range("A4:AE4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$4:$AE$7").AutoFilter Field:=1, Criteria1:=Sheets("PrintDupla").Range("BF2").Text
    ActiveSheet.Range("$A$4:$AE$7").AutoFilter Field:=2, Criteria1:=Sheets("PrintDupla").Range("Q13").Text

Call CopiarFiltro
    
End Sub
Sub CopiarFiltro()

    Worksheets("Registos").Range("A1:AE1").Clear
    Set rng = AutoFilter.Range
    rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
    Destination:=Worksheets("Registos").Range("A1")
    
End Sub

I want run automatly this code when the value of Sheets("PrintDupla").Range("Q13") change... and it change For Each rngCell In Sheets("Dados").Range("N19:N55")... see code below

In the Sheet("PrintDupla"):

Sub Imprimir1()
'
' Imprimir1 Macro
' Macro gravada em 10-02-2011 por Galas
'
Dim MyRange As Range
Dim rngCell As Range
   Application.ScreenUpdating = False
   Set MyRange = Range("A1:L58")
    With ActiveSheet.PageSetup
        .TopMargin = 0.12 * 72
        .LeftMargin = 0.25 * 72
        .BottomMargin = 0.14 * 72
        .RightMargin = 0.21 * 72
        .HeaderMargin = 0.07 * 72
        .FooterMargin = 0.05 * 72
        .PrintArea = MyRange.Address
    End With

    For Each rngCell In Sheets("Dados").Range("N19:N55")
        If rngCell.Value = True Then
            With Sheets("PrintDupla")
               
                .Range("BF2").Value = rngCell.Offset(0, -2).Value
                
                ActiveWindow.SelectedSheets.PrintPreview
            End With
        End If
    Next rngCell
    
Call Clear
    
    Application.ScreenUpdating = True
End Sub

Any help, it will save me hours of work. Thanks