Microsoft Office Forums - View Single Post - [Solved] Find specific rows then copy and paste to new doc

macropod · 02-16-2014, 04:34 PM

Hi Carol,

Try:

Code:

Sub Demo()
Dim DocSrc As Document, DocTgt As Document, Tbl As Table, TblRw As Row
Set DocSrc = ThisDocument
Set DocTgt = ActiveDocument
With DocSrc
  For Each Tbl In .Tables
    For Each TblRw In Tbl.Columns(3).Cells
      With TblRw.Range
        If InStr(.Text, "Draft") > 0 Then
          .Rows(1).Range.Copy
          DocTgt.Range.Characters.Last.Paste
        End If
      End With
    Next
  Next
End With
Set DocSrc = Nothing: Set DocTgt = Nothing
End Sub

Note: As coded, the source and target documents are specified as 'ThisDocument' and 'ActiveDocument', respectively. You'll need to make the appropriate modifications to the code if that's not the case.