Excel VBA - How to copy rows found & to cater if no rows found via autofilter

Excel VBA - How to copy rows found & to cater if no rows found via autofilter

Post by kazz » Thu, 17 Feb 2011 13:43:24


Hi VBAers,

I need to copy autofilter rows from one worksheet to another (within
the same workbook).

My autofilter code is:

Columns("W:W").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:="TRUE"

I'm not sure how to do the following:

1) code to copy the rows found to the other worksheet
2) how to cater for the situation if no rows are found.

I've researched but all the help Google returns is rather confusing.
Can someone please advise.
 
 
 

Excel VBA - How to copy rows found & to cater if no rows found via autofilter

Post by kazz » Fri, 18 Feb 2011 11:10:57


> Selection.AutoFilter Field:=1, Criteria1:="T>UE>
>
> I'm not sure how to do the follow>ng>
>
> 1) ode to copy the rows found to the other works>eet
> 2) how to cater for the situation if no rows are fo>nd>
>
> I've researched but all the help Google returns is rather confus>ng.
> Can someone please advise.

All is good now. I finally found some code on 'Big Resource' (http://
excel.bigresource.com/Track/excel-olTmyvm0/) & adjusted it to suit my
needs, eg; pastes rows from row 4 (via 'NR's A4:M4) into the
destination worksheet named "Content Addition TGA".

Should this help someone in future:- I ditched the 'autofilter code'
stated above. Following is the code this is working:

Sub W_TGAFilter_Transfer()

Dim NR As Long, c As Range, firstaddress As String
Dim wb1 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set wb1 = ActiveWorkbook
Set ws1 = wb1.Worksheets("Combined")
Set ws2 = wb1.Worksheets("Content Addition TGA")

Application.ScreenUpdating = False

NR = ws2.Range("A4:M4").End(xlUp).Row + 1
With ws1.Columns("W")
Set c = .Find("TRUE", LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstaddress = c.Address
Do
ws1.Range("A" & c.Row & ":M" & c.Row).Copy ws2.Range("A" & NR)
NR = NR + 1
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Add&g<;ess <> firstaddress
End If
End With

ws1.Select
Application.ScreenUpdating = True

End Sub