As soon as I re-read your post i suspected you wanted it for every sheet so
try this

Sub copyit()
Dim MyRange, MyRange1 As Range
Dim ws As Worksheet
x = 1
For Each ws In ThisWorkbook.Worksheets
Worksheets(x).Select
If ws.Name < "Titles" And ws.Name < "TOC" Then
lastrow = Cells(Rows.Count, "G").End(xlUp).Row
Set MyRange = Worksheets(x).Range("G1:G" & lastrow)
For Each c In MyRange
If UCase(c.Value) = "X" Then
If MyRange1 Is Nothing Then
Set MyRange1 = c.Offset(, -3)
Else
Set MyRange1 = Union(MyRange1, c.Offset(, -3))
End If
End If
Next
End If
If Not MyRange1 Is Nothing Then
MyRange1.Select
Selection.Copy
Sheets("Titles").Select
Cells(Cells(Rows.Count, "A").End(xlUp).Row, 1).Select
ActiveSheet.Paste
End If
x = x + 1
Set MyRange1 = Nothing
Next
Application.CutCopyMode = False
End Sub

Mike

"CJ" wrote:

Thanks Mike! This worked for me below! Can you help me get this to
run for every worksheet in the active workbook where worksheet.name <
"TOC" or < "List"? Then with the data generated for each MyRange1, on
the "Title" worksheet append it to the next available row column A.
(Maybe leaving a space between each)


---------------------------------
Sub copyit()
Dim MyRange, MyRange1 As Range
lastrow = Cells(Rows.Count, "G").End(xlUp).Row
Dim c As Range
Set MyRange = Sheets("xyz").Range("G12:G" & lastrow)
Sheets("xyz").Select

For Each c In MyRange
If c.Value = "Status:" Then
If MyRange1 Is Nothing Then
Set MyRange1 = c.Offset(, -3)
Else
Set MyRange1 = Union(MyRange1, c.Offset(, -3))
End If
End If
Next

If Not MyRange1 Is Nothing Then
MyRange1.Select
Selection.Copy
Sheets("Title").Select
Range("A1").Select
ActiveSheet.Paste
End If

End Sub