I was getting an error on your strWbkName line. Are you? Give this a try:

Sub A1ReNmWksht()

Dim strWbkName As String
Dim wbk As Workbook
Dim wks As Worksheet
Dim lngLastSheet As Long

' get last 3 characters of the workbook name- minus file extension
strWbkName = Mid(ActiveWorkbook.Name, 5, InStr(ActiveWorkbook.Name, ".")
- 5)

' where you want the data to go
Set wbk = Workbooks("TROABook-200-299.xlsx")
lngLastSheet = wbk.Sheets.Count

' find worksheet name and change worksheet name if found
For Each wks In ActiveWorkbook.Worksheets
Select Case wks.Name
Case "Sum", "Summary", "SUM", "summary"
With wks
.Name = "Sum-" & strWbkName
.Copy After:=wbk.Sheets(lngLastSheet)
End With


Case "APN"
With wks
.Name = "APN-" & strWbkName
.Copy After:=wbk.Sheets(lngLastSheet)
End With

End Select
Next wks

End Sub


--
Cheers,
Ryan


"SteveDB1" wrote:

Yes, the final destination workbook is open.
The entirety of the code is:
------------------------------------------------------------
Sub A1ReNmWksht()

Dim strWbkName As String

Dim wks As Worksheet

' get last 3 characters of the workbook name- minus file extension
strWbkName = Mid(ActiveWorkbook.Name, 5, InStr(ActiveWorkbook.Name, ".")
- 5)


' find worksheet name and change worksheet name if found
For Each wks In ActiveWorkbook.Worksheets
Select Case wks.Name
Case "Sum", "Summary", "SUM", "summary"
wks.Name = "Sum-" & strWbkName
wks.Copy
after:=Sheets(Workbooks("TROABook-200-299.xlsx").Sheets.count)



Case "APN"
wks.Name = "APN-" & strWbkName
wks.Copy
after:=Worksheets(Workbooks("TROABook-200-299.xlsx").Sheets.count)

End Select

Next wks

End Sub
-------------------------------------------------------------
Again, thank you.



"RyanH" wrote:

Is the Workbooks("TROABook-200-299.xlsx") open? If it is not open you will
get that error.

Can you post the rest of the code? This will help me to diagnose things.
--
Cheers,
Ryan


"SteveDB1" wrote:

Barb, and Ryan,

Thank you both for your responses.
I've tried both and get the same error.
subscript out of range.

For Ryan's, the error occurs with the
wks.Copy After:=Sheets(Workbooks("TROABook-200-299.xlsx").Sheets.Count)

.....:= sheets(...) component.

the line shows 23 sheets, within the (Workbooks(...).sheets.count element,
but once it is "outside" with the sheets(....) portion it gives the subscript
out of range error.


For Barb's, the error occurs
Set newWB = Workbooks("TROABook-200-299")
workbooks(...) = <subscript out of range component.
Barb, what if, instead of a new workbook, it just sets the TROABook as being
active?

I copied your forms and pasted each-- to make sure I didn't mis-type anything.

Again-- thank you both.