help with altering existing code

[Guest]

I found this code in another post and tried to alter it to accomodate my
application but it is not working for me. Any help you can give me is
appreciated, thank you.

I have a WB with 11 WS followed by a worksheet titled, "Summary". I have a
button on the Summary and when it in clicked I need this code to bring in the
data from any rows populted, but just the data in Col B and Col C from each
of the previous 11 WS and copy that data
to col B and C on the Summary WS beginning with row 3. Then for each cell on
the summary page that is populated with data in Col B, I need it to add the
number of the row in Col A beginning with number 3 since that is the row that
the data starts on.

Currently I have this code stored in the Summary Page. Thanks again for
your help.

Sub PopulateSummary()
Dim wSh As Worksheet, wTarget As Worksheet
Dim xlr As Long, xr As Long, xTarget As Long

' set up final sheet
Set wTarget = Worksheets("Summary")
With wTarget
..Cells.ClearContents
..Cells(3, 1) = "ColumnB"
..Cells(3, 2) = "ColumnC"
..Cells(3, 3) = "Source WS"
..Cells(3, 4) = "Source Row"
End With
xTarget = 2

' scan all Sheets prefixed WS and copy to target
For Each wSh In ActiveWorkbook.Worksheets
If UCase(Left(wSh.Name, 2)) = "WS" Then
With wSh
xlr = .Cells(.Rows.Count, "B").End(xlUp).Row
If .Cells(.Rows.Count, "C").End(xlUp).Row > xlr Then _
xlr = .Cells(.Rows.Count, "C").End(xlUp).Row
For xr = 1 To xlr
If Len(Trim(.Cells(xr, 1))) > 0 Or Len(Trim(.Cells(xr, 2))) > 0 Then
..Range(.Cells(xr, 1), .Cells(xr, 2)).Copy
Destination:=wTarget.Cells(xTarget, 1)
wTarget.Cells(xTarget, 3) = wSh.Name
wTarget.Cells(xTarget, 4) = xr
xTarget = xTarget + 1
End If
Next xr
End With
End If
Next wSh

End Sub

 

[Guest]

This might be your problem area.

For xr = 1 To xlr
If Len(Trim(.Cells(xr, 1))) > 0 Or Len(Trim(.Cells(xr, 2))) > 0 Then
..Range(.Cells(xr, 1), .Cells(xr, 2)).Copy

What you are setting your critria on is xr,Col "A" and xr,Col "B" and
telling it to copy xr, Col "A" : xr, Col "B"

I believe you stated that it was columns B and C that you wanted to copy.
Try this:

For xr = 1 To xlr
If Len(Trim(.Cells(xr, 2))) > 0 Or Len(Trim(.Cells(xr, 3))) > 0 Then
..Range(.Cells(xr, 2), .Cells(xr, 3)).Copy

 

[Guest]

Thanks for the suggestion, I made the change but the data in the rows is not
being copied to the summary, only the words

"ColumnB" in Row 3, Col B
"ColumnC" in Row 3, Col C
"Source WS" in Row 3 Col D and
"Source Row" in Row 3 Col E

The data in the rows in the worksheets is not being copied, do you have any
other suggestions. Thanks