Hi,
Try the following code.
''' -------------------------------
Sub test()
Dim c As Range
Dim result As Range
Dim firstAddress As String
''' find all FC cells
With ActiveSheet.Range("B:B") ''' <<<<< Range to search
Set c = .Find("FC", LookIn:=xlValues, lookat:=xlWhole) ''' <<<<< what to
search for
If Not c Is Nothing Then
firstAddress = c.Address
Do
If result Is Nothing Then
Set result = c
Else
Set result = Application.Union(result, c)
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
''' copy/paste
If Not result Is Nothing Then ''' if some cells were found
For Each c In result.Cells
Set c = Application.Intersect(c.EntireRow _
, c.Parent.Range("C:T"))
c.Copy c.Offset(1, 0)
Next
End If
End Sub
''' -------------------------------
Potential issue: in the copy/paste section, if 2 FC cells follow each other
then copy/pasting the 1st one will overwrite the second FC row data therefore
the second copy/paste will carry over on the 3rd row the data of the 1st FC
row. Now, it is possible that this cannot happen in your situation, say for
example that your sheet is organized in such a way that no 2 FC can follow
each other. If this can happen however, you'll need to rewrite the Copy/Paste
section to start copying/pasting the last row and going up.
