Example:

Sheet"xyz"
A B C D E F G H I
r x
s x
t x

Sheet"Titles"
A B C D E F G H I
r
s
t


IF worksheet name < "Titles" and value in column G = "x" THEN
for that same row, get the cell value in column D, and populate a
list in column A on worksheet name = "Titles"


THANK YOU for your help! I'm stuck.

CJ,

Alt + F11 to open VB editor, right click 'This Workbook' and insert module,
paste this in and run it.

Sub copyit()
Dim MyRange, MyRange1 As Range
lastrow = Cells(Rows.Count, "G").End(xlUp).Row
Set MyRange = Sheets("xyz").Range("G1:G" & lastrow)
Sheets("xyz").Select
For Each c In MyRange
If UCase(c.Value) = "X" Then
If MyRange1 Is Nothing Then
Set MyRange1 = c.Offset(, -6)
Else
Set MyRange1 = Union(MyRange1, c.Offset(, -6))
End If
End If
Next
If Not MyRange1 Is Nothing Then
MyRange1.Select
Selection.Copy
Sheets("Titles").Select
Range("A1").Select
ActiveSheet.Paste
End If
End Sub

Mike

"CJ" wrote:

Example:

Sheet"xyz"
A B C D E F G H I
r x
s x
t x

Sheet"Titles"
A B C D E F G H I
r
s
t


IF worksheet name < "Titles" and value in column G = "x" THEN
for that same row, get the cell value in column D, and populate a
list in column A on worksheet name = "Titles"


THANK YOU for your help! I'm stuck.

OOPS,

the offset is -3 not minus -6 you wanted to copy column D

Mike

"CJ" wrote:

Example:

Sheet"xyz"
A B C D E F G H I
r x
s x
t x

Sheet"Titles"
A B C D E F G H I
r
s
t


IF worksheet name < "Titles" and value in column G = "x" THEN
for that same row, get the cell value in column D, and populate a
list in column A on worksheet name = "Titles"


THANK YOU for your help! I'm stuck.

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

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

I forgot the space between the rows add this line between the 2 existing lines

Cells(Cells(Rows.Count, "A").End(xlUp).Row, 1).Select

If ActiveCell.Row < 1 Then ActiveCell.Offset(2, 0).Select 'new line

ActiveSheet.Paste

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

I get an error upon running for:

Selection.Copy

"That command cannot be used on multiple selections."

I get and error on

Selection.Copy

"cannot be used on multiple selections"

On Apr 21, 10:13 pm, CJ wrote:
I get an error upon running for:

Selection.Copy

"That command cannot be used on multiple selections."

This seems like it could be related to some of the columns with value
'X' are merged and others are not.