macro moving sheets with dynamic names

[cstarnite]

I need help with the line moving sheet to another workbook and inserting after a specific tab. The worksheet is updated weekly and the tab names are created for each week (see last line). The name of the previous week is kept in cell ba12. I need the sheet to insert after the previous weeks report.

Dim prsheet As String
prsheet = [ba11]
Sheets("Weekly Rpt").Select

'error occurs on next line?????
Sheets("Weekly Rpt").Copy After:=Sheets(prsheet)
Sheets("Weekly Rpt").Select
Sheets("Weekly Rpt").Name = InputBox("Please rename this weeks sheet (Format - WE mm.dd.yy)")

 

[xenou]

Hi:
I don't see why your routine fails. It occurs to me you don't need to keep the last sheet name in a cell or have the user input a new name...
the last sheet name has a date, and the new sheet name is that date plus 7. Also, the location is always the last sheet so we can use the Worksheets.Count to place it regardless of the sheet names.

Sub testcode()

Dim myOldLastSheet As Integer, myNewLastSheet As Integer
Dim lastShName As String, newShName As String
Dim lY, lM, lD, lDate As Date
Dim nY, nM, nD, nDate As Date

'Index number of prior week's sheet - always last sheet
myOldLastSheet = Worksheets.Count

'Parse last weeks sheet name to get a date string for new name
lastShName = Worksheets(myOldLastSheet).Name
    lY = CStr(20 & Right(lastShName, 2))
    lM = Mid(lastShName, 4, 2)
    lD = Mid(lastShName, 7, 2)
    lDate = DateSerial(lY, lM, lD)
    nDate = lDate + 7
    nD = CStr(Format(Day(nDate), "00"))
    nM = CStr(Format(Month(nDate), "00"))
    nY = Right(CStr(Format(Year(nDate), "00")), 2)
newShName = "WE " & nM & "." & nD & "." & nY
    
'Copy and rename weekly report for records
Worksheets("Weekly Report").Copy After:=Worksheets(myOldLastSheet)
myNewLastSheet = Worksheets.Count
Sheets(myNewLastSheet).Name = newShName

End Sub

I suspect that I may not have needed the CStr functions but I wanted to be on the safe side.

let me know if this works for you...if it does then maybe the cell with the sheet name and the input box can be done without.

 

[xenou]

I added some extra functionality to make this more user friendly.

Sub testcode()

Dim sh As Worksheet, booFound As Boolean
Dim myOldLastSheet As Integer, myNewLastSheet As Integer
Dim lastShName As String, newShName As String
Dim lY, lM, lD, lDate As Date
Dim nY, nM, nD, nDate As Date
Dim msg As String, ans As Integer

'*****New*****
'Check for existence of sheet to be copied
booFound = False
For Each sh In Worksheets
    If sh.Name = "Weekly Report" Then
        booFound = True
    End If
Next sh

If booFound = False Then
    MsgBox ("The routine has encountered an error.  A sheet named ""Weekly Report"" does not exist")
    End
End If
'*************

'Index number of prior week's sheet - always last sheet
myOldLastSheet = Worksheets.Count

'Parse last weeks sheet name to get a date string for new name
lastShName = Worksheets(myOldLastSheet).Name
    lY = CStr(20 & Right(lastShName, 2))
    lM = Mid(lastShName, 4, 2)
    lD = Mid(lastShName, 7, 2)
    lDate = DateSerial(lY, lM, lD)
    nDate = lDate + 7
    nD = CStr(Format(Day(nDate), "00"))
    nM = CStr(Format(Month(nDate), "00"))
    nY = Right(CStr(Format(Year(nDate), "00")), 2)
newShName = "WE " & nM & "." & nD & "." & nY
    
'Copy and rename weekly report for records
Worksheets("Weekly Report").Copy After:=Worksheets(myOldLastSheet)
myNewLastSheet = Worksheets.Count
Sheets(myNewLastSheet).Name = newShName


'*****NEW*****
'Communicate to user results of routine
msg = "Worksheets ""Weekly Report"" was successfully copied." & vbCrLf & vbCrLf
msg = msg & "The copy was named """ & lastShName & """ and moved to the end."

ans = MsgBox(msg, vbInformation)

Sheets("Weekly Report").Select
'*************

End Sub