chris1234567
New Member
- Joined
- Sep 21, 2006
- Messages
- 12
I have the underneath code as you can see it looks in all the different ranges using the find command to find the letter T then copies that row to the front sheet the only trouble is it only finds one T per sheet I need it to copy all the T's on the sheet before it moves onto the next range.
Any help appreciated
Private Sub Worksheet_Activate()
Dim target
Dim range
Dim ws As Worksheet
Dim i
Dim rng(26) As Variant
Dim r
Set rng(1) = Sheets("a").range("b2:b50")
Set rng(2) = Sheets("b").range("b2:b50")
Set rng(3) = Sheets("b").range("b2:b50")
Set rng(4) = Sheets("d").range("b2:b50")
Set rng(5) = Sheets("e").range("b2:b50")
Set rng(6) = Sheets("f").range("b2:b50")
Set rng(7) = Sheets("g").range("b2:b50")
Set rng(8) = Sheets("h").range("b2:b50")
Set rng(9) = Sheets("i").range("b2:b50")
Set rng(10) = Sheets("j").range("b2:b50")
Set rng(11) = Sheets("k").range("b2:b50")
Set rng(12) = Sheets("l").range("b2:b50")
Set rng(13) = Sheets("m").range("b2:b50")
Set rng(14) = Sheets("n").range("b2:b50")
Set rng(15) = Sheets("o").range("b2:b50")
Set rng(16) = Sheets("p").range("b2:b50")
Set rng(17) = Sheets("q").range("b2:b50")
Set rng(18) = Sheets("r").range("b2:b50")
Set rng(19) = Sheets("s").range("b2:b50")
Set rng(20) = Sheets("t").range("b2:b50")
Set rng(21) = Sheets("u").range("b2:b50")
Set rng(22) = Sheets("v").range("b2:b50")
Set rng(23) = Sheets("w").range("b2:b50")
Set rng(24) = Sheets("x").range("b2:b50")
Set rng(25) = Sheets("y").range("b2:b50")
Set rng(26) = Sheets("z").range("b2:b50")
i = 1
For counter = 1 To 26
Set r = rng(i).Find("t")
If Not r Is Nothing Then
r.EntireRow.Copy Destination:=Sheets("reliance staff").Cells(Rows.Count, "b").End(xlUp).Offset(1, -1)
End If
i = i + 1
Next
Any help appreciated
Private Sub Worksheet_Activate()
Dim target
Dim range
Dim ws As Worksheet
Dim i
Dim rng(26) As Variant
Dim r
Set rng(1) = Sheets("a").range("b2:b50")
Set rng(2) = Sheets("b").range("b2:b50")
Set rng(3) = Sheets("b").range("b2:b50")
Set rng(4) = Sheets("d").range("b2:b50")
Set rng(5) = Sheets("e").range("b2:b50")
Set rng(6) = Sheets("f").range("b2:b50")
Set rng(7) = Sheets("g").range("b2:b50")
Set rng(8) = Sheets("h").range("b2:b50")
Set rng(9) = Sheets("i").range("b2:b50")
Set rng(10) = Sheets("j").range("b2:b50")
Set rng(11) = Sheets("k").range("b2:b50")
Set rng(12) = Sheets("l").range("b2:b50")
Set rng(13) = Sheets("m").range("b2:b50")
Set rng(14) = Sheets("n").range("b2:b50")
Set rng(15) = Sheets("o").range("b2:b50")
Set rng(16) = Sheets("p").range("b2:b50")
Set rng(17) = Sheets("q").range("b2:b50")
Set rng(18) = Sheets("r").range("b2:b50")
Set rng(19) = Sheets("s").range("b2:b50")
Set rng(20) = Sheets("t").range("b2:b50")
Set rng(21) = Sheets("u").range("b2:b50")
Set rng(22) = Sheets("v").range("b2:b50")
Set rng(23) = Sheets("w").range("b2:b50")
Set rng(24) = Sheets("x").range("b2:b50")
Set rng(25) = Sheets("y").range("b2:b50")
Set rng(26) = Sheets("z").range("b2:b50")
i = 1
For counter = 1 To 26
Set r = rng(i).Find("t")
If Not r Is Nothing Then
r.EntireRow.Copy Destination:=Sheets("reliance staff").Cells(Rows.Count, "b").End(xlUp).Offset(1, -1)
End If
i = i + 1
Next