Copy Unknown Rows To Another Sheet

[blu817]

Hello

I have a spreadsheet with multiple columns that after filtering column G I want to copy those lines onto another spreadsheet. My hurdle is that those lines vary, it could be one, ten, etc. Without getting into too much detail here is part of the code. Essentially I want to copy any lines that have "Type of Cash Dividend: Special Cash" in the cell. Any direction would be greatly appreciated.



Rows("1:1").Select
Selection.AutoFilter
ActiveCell.FormulaR1C1 = " Type of Cash Dividend: Special Cash"
ActiveSheet.Range("$A$1:$M$141").AutoFilter Field:=7, Criteria1:= _
"=Type of Cash Dividend: Special Cash", Operator:=xlAnd

 

[My Aswer Is This]

Try this script:

Look at the portions highlighted in red and change the sheet names as needed I assume we will be searching column 7 if not modify script portion marked in red.

Sub Auto_Filter_This_New()
Application.ScreenUpdating = False
'Modified 8-30-17 7:40 PM EDT
Dim ans As String
Dim Col As Long
Dim One As String
Dim Two As String
One = "[COLOR=#ff0000]CopyFrom[/COLOR]" 'Change sheet name here
Two = "[COLOR=#ff0000]CopyTo[/COLOR]" 'Change sheet name here
Col = "[COLOR=#ff0000]7[/COLOR]" ' Change Column to search here
Sheets(One).Activate
Sheets(One).Rows(1).Copy Sheets(Two).Rows(1)
Lastrow = Sheets(One).Cells(Rows.Count, Col).End(xlUp).Row
Lastrowa = Sheets(Two).Cells(Rows.Count, Col).End(xlUp).Row + 1
ans = "Type of Cash Dividend: Special Cash"
    
    With Worksheets(One).Rows("1:" & Lastrow)
        .AutoFilter
        .AutoFilter Field:=Col, Criteria1:=ans
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy Worksheets(Two).Range("A" & Lastrowa)
        '.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    
    
    End With
    
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub