VB

[Chuck]

Can anyone help?

Ser Ser No Date Insp Rate Date Next Insp Test Type
Remarks
A001 AG1123 15-04-07 S 15-04-08 Max 15
A002 AG1265 15-04-07 S 15-04-08 Min
A003 AG1556 17-05-07 S 17-05-08 Anu
A004 AG2314 15-03-07 S 15-03-08 Max 27
A005 AH435R1 17-07-07 U/S 17-07-08 Anu

How do I find a row in sheet 1and 2 which starts with "Max" in colum F

then

Paste all the rows that start with "Max" from sheets 1 and 2 into sheet 3.
There could be 100 rows that start with "Max" in and they all need to be
copied and pasted from sheet1 and 2, on the other side there could be no
colums starting with max.

i have had some help which has done the job to a degree. Before it was an
exact word and it was from only one sheet, I thought that I would be able to
sort out the rest……….. I have used the following:

Sub copyit()
Dim MyRange, MyRange1 As Range
Sheet1.Select
LastRow = Sheet1.Range("F65536").End(xlUp).Row
Set MyRange = Sheet1.Range("F1:F" & LastRow)
For Each C In MyRange
If UCase(C.Value) = "max" Then
If MyRange1 Is Nothing Then
Set MyRange1 = C.EntireRow
Else
Set MyRange1 = Union(MyRange1, C.EntireRow)
End If
End If
Next
Sheet3.Select
Range("A11:x60").Delete
MyRange1.Copy
Sheet3.Select
Range("A11").Select
ActiveSheet.Paste
End Sub

 

[excelent]

Sub Copy1and2()
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
Set sh3 = Sheets("Sheet3")
rw1 = sh1.Cells(1000, "A").End(xlUp).Row
rw2 = sh2.Cells(1000, "A").End(xlUp).Row
sh3.Range("A2:F1000") = "" ' reset Sheet3
For t = 1 To rw1
rw3 = sh3.Cells(1000, "A").End(xlUp).Row + 1
If Left(sh1.Cells(t, "F"), 3) = "Max" Then
sh1.Range("A" & t & ":F" & t).Copy sh3.Cells(rw3, "A")
End If
Next
For t = 1 To rw2
rw3 = sh3.Cells(1000, "A").End(xlUp).Row + 1
If Left(sh2.Cells(t, "F"), 3) = "Max" Then
sh2.Range("A" & t & ":F" & t).Copy sh3.Cells(rw3, "A")
End If
Next
End Sub


"Chuck" skrev:

 

[Chuck]

Many thanks, all works well

Sub Copy1and2()
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
Set sh3 = Sheets("Sheet3")
rw1 = sh1.Cells(1000, "A").End(xlUp).Row
rw2 = sh2.Cells(1000, "A").End(xlUp).Row
sh3.Range("A2:F1000") = "" ' reset Sheet3
For t = 1 To rw1
rw3 = sh3.Cells(1000, "A").End(xlUp).Row + 1
If Left(sh1.Cells(t, "F"), 3) = "Max" Then
sh1.Range("A" & t & ":F" & t).Copy sh3.Cells(rw3, "A")
End If
Next
For t = 1 To rw2
rw3 = sh3.Cells(1000, "A").End(xlUp).Row + 1
If Left(sh2.Cells(t, "F"), 3) = "Max" Then
sh2.Range("A" & t & ":F" & t).Copy sh3.Cells(rw3, "A")
End If
Next
End Sub


"Chuck" skrev: