Copying A Range of Cells to Another Worksheet

[Rodman]

I am trying to copy a range of cells from one worksheet to another
(worksheet); based on the text in a specific cell.

Using the range B2 through H500:
If the text in cell B(x) = "Emergency"
then copy cells H(x), I(x), J(x), C(x), D(x), E(x), F(x), G(x)
into another worksheet in the same order.

(In the above example x represents the range 2 through 500)

I have tried using a formula but that doen not work. Any suggestions in the
form of a formula of a Macro/VBA would be greately appreciated!

Can Anyone Help?

Thanks in Advance.

 

[Rodman]

Mike,

Thanks for your quick response. It worked fine, however, I failed to
mention that the data being copied into the other worksheet must start at the
third line (this macro moves the data to cells starting at line 1).

Can you give me the modifications?

Thanks!

 

[Mike H]

Hi,

Only a small change required to do that

Sub copyit()
Dim MyRange As Range
Set MyRange = Range("B2:B500")
If Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row < 3 Then
lastrow = 3
Else
lastrow = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
End If
For Each c In MyRange
If InStr(1, UCase(c.Value), "EMERGENCY", 0) Then
Sheets("Sheet2").Cells(lastrow, 1).Value = c.Offset(, 6).Value
Sheets("Sheet2").Cells(lastrow, 2).Value = c.Offset(, 7).Value
Sheets("Sheet2").Cells(lastrow, 3).Value = c.Offset(, 8).Value
Sheets("Sheet2").Cells(lastrow, 4).Value = c.Offset(, 1).Value
Sheets("Sheet2").Cells(lastrow, 5).Value = c.Offset(, 2).Value
Sheets("Sheet2").Cells(lastrow, 6).Value = c.Offset(, 3).Value
Sheets("Sheet2").Cells(lastrow, 7).Value = c.Offset(, 4).Value
Sheets("Sheet2").Cells(lastrow, 8).Value = c.Offset(, 5).Value
lastrow = lastrow + 1
End If
Next
End Sub

Mike

 

[Rodman]

Thanks For Your Help!
--
Rodman Veney

Hi,

Only a small change required to do that

Sub copyit()
Dim MyRange As Range
Set MyRange = Range("B2:B500")
If Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row < 3 Then
lastrow = 3
Else
lastrow = Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row
End If
For Each c In MyRange
If InStr(1, UCase(c.Value), "EMERGENCY", 0) Then
Sheets("Sheet2").Cells(lastrow, 1).Value = c.Offset(, 6).Value
Sheets("Sheet2").Cells(lastrow, 2).Value = c.Offset(, 7).Value
Sheets("Sheet2").Cells(lastrow, 3).Value = c.Offset(, 8).Value
Sheets("Sheet2").Cells(lastrow, 4).Value = c.Offset(, 1).Value
Sheets("Sheet2").Cells(lastrow, 5).Value = c.Offset(, 2).Value
Sheets("Sheet2").Cells(lastrow, 6).Value = c.Offset(, 3).Value
Sheets("Sheet2").Cells(lastrow, 7).Value = c.Offset(, 4).Value
Sheets("Sheet2").Cells(lastrow, 8).Value = c.Offset(, 5).Value
lastrow = lastrow + 1
End If
Next
End Sub

Mike