macro moving sheets with dynamic names

cstarnite

New Member
Joined
Jul 18, 2007
Messages
12
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)")
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

xenou

MrExcel MVP
Joined
Mar 2, 2007
Messages
16,836
Office Version
  1. 2019
Platform
  1. Windows
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.

Code:
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

MrExcel MVP
Joined
Mar 2, 2007
Messages
16,836
Office Version
  1. 2019
Platform
  1. Windows
I added some extra functionality to make this more user friendly.

Code:
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
 

Forum statistics

Threads
1,181,648
Messages
5,931,213
Members
436,784
Latest member
amuljono

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top