Help with existing code

[ploddinggaltn]

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 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 iwth number 3 since that is the row that
the data starts at.

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

 

[ploddinggaltn]

Sorry, I posted this question on the incorrect topic site