Copy rows with specific text from multiple Worksheets to another worksheet

[craigy111]

HI guys.

I would like to copy rows from multiple worksheets (Jan to Dec) that contain certain text - WON, PENDING, LOST - When a VBA Button is pressed on another Worksheet the information is copied to VIEW. So far i can copy from only one worksheet at a time.

CODE so far

Sub CopyWONtoView()

Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet

Set Source = ActiveWorkbook.Worksheets("Jan")
Set Target = ActiveWorkbook.Worksheets("VIEW")

Target.Range("$A$4:$R$50").Clear

j = 4 ' Start copying to row 4 in target sheet
For Each c In Source.Range("A4:A95")
If c = "WON" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c

Worksheets("VIEW").Activate

End Sub

Any and all help would be much appreciated.

 

[craigy111]

Thanks again but nope..........It only returns 1 result............I'm pulling my
hair out with this.

 

[Fluff]

Thanks again but nope..........It only returns 1 result............I'm pulling my
hair out with this.

At least you've still got some, I'm as a coot.

 

[Fluff]

Firstly, did you remember to change the criteria from
=chr20 to =WON?
Secondly do you how to step through the code in the module?

 

[craigy111]

Cheers

Its looking like........Well its looking like another "Back to the drawing board" ones.

 

[craigy111]

Yip Changed =chr20 to =WON.

Just found out how to step through the code and it would appear to search through all the
worksheets and look at the WON lines but for some reason after MARCH it stops copying
and pasting.

 

[craigy111]

Im a fool.

Got it working. I didn't notice the +1.

Final Code:

Sub CopyDatatoView()

Dim UsdRws As Long
Dim Ws As Worksheet
Dim DstSht As Worksheet

Set DstSht = ActiveWorkbook.Worksheets("VIEW")

DstSht.Rows("5:" & Rows.Count).Clear

For Each Ws In Worksheets
If Ws.Name <> "View" And Ws.Name <> "REVIEW" And Ws.Name <> "LIST" And Ws.Name <> "DATA" Then

UsdRws = Ws.Range("A" & Rows.Count).End(xlUp).Row

Ws.Range("A5").AutoFilter
Ws.Range("A5:A" & UsdRws).AutoFilter Field:=1, Criteria1:="=WON"
On Error Resume Next
Ws.Range("A6:A" & UsdRws + 1).SpecialCells(xlVisible).EntireRow.Copy _
DstSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
On Error GoTo 0
Ws.Range("A5").AutoFilter
End If
Next Ws

DstSht.Activate

End Sub


Thank you very much, i owe you a pint or two

 

[craigy111]

Bugger its running the MACRO twice before ending so its now giving me all results twice.

Any advice on this..........

I think i'm going to have to study VBA coding.

 

[Fluff]

In this line

If Ws.Name <> "View" And

View should be in caps

 

[craigy111]

Cheers Worked a treat.

I have learned a lot here thanks again.

 

[Fluff]

Glad to help & thanks for the feedback