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

  • Thread starter Thread starter kazzy
  • Start date Start date
K

kazzy

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.
 
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.
Click to expand...

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.Address <> firstaddress
End If
End With

ws1.Select
Application.ScreenUpdating = True

End Sub
 
Back
Top