Multiple sheets in a workbook rota.

[GaryHealey]

Hi All

I'm having an absolute nightmare trying to sort my rota out, I have 52 sheets (weeks 1 to 52) in a workbook, each worksheet has a table.
I need to update all future sheets if someone leaves or someone joins, I've tried doing this with selecting all sheets, however, they are tables and this is not possible.

I have tried the following macro to change a name on a specific cell but due to my lack of knowledge it causes an error.

Can you please help me?

Cheers

Gary

Sub NAMESROTA()
'
' NAMESROTA Macro
' CHANGE THE NAME ON THE ROTA
'

'Dim Sh As Worksheet
Application.ScreenUpdating = False
For Each Sh In Windows("Rota NMEA Fiscal 2023 2024 .xlsx").Activate
With Sh
Windows("Rota NMEA Fiscal 2023 2024 .xlsx").Activate
Range("B27").Select
ActiveCell.FormulaR1C1 = "Mark Richards"
End With
With Sheets("WEEK 17")
Next Sh

End Sub

 

[RudRud]

Hi @GaryHealey , below code only add new week and copy data from previous week.

Option Compare Text
Option Explicit
Sub test()
Dim lweek As String
Dim a As Variant
Dim i%, k%, j%, tblname%
Dim answer As Byte
Dim lastdate As Date
Dim ws As Worksheet
Dim ss As Range
Set ws = Sheets("TEMPLATE")
'Dim dict As New Dictionary
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
ReDim b(1 To 10000, 1 To 3)
dict.CompareMode = vbTextCompare
Application.ScreenUpdating = False

lweek = Right(Sheets(Sheets.Count).Name, 2)
lastdate = DateAdd("D", (lweek - 35) * 5, DateSerial(2023, 9, 1))

'create new sheet with values
answer = MsgBox("Do you want Create a new Week Sheet Yes" & vbNewLine & "Yes:Create new sheet", vbQuestion + vbYesNo + vbDefaultButton2, "asd")

If answer = vbYes Then
    With Sheets("WEEK " & lweek) 'Current Week
       tblname = Right(.[a2].ListObject.Name, 2) + 1
       Sheets.Add(after:=Sheets(Sheets.Count)).Name = "WEEK " & lweek + 1
       .Range("a1:j" & .Cells(Rows.Count, "A").End(xlUp).Row).Copy Sheets("WEEK " & lweek + 1).[a1]
    End With
    
   With Sheets("WEEK " & lweek + 1) 'New Week
        .Columns("A:J").AutoFit
        .[a2].ListObject.Name = "Table" & tblname
        For Each ss In .Range("c1:g1")
            i = i + 1
             ss.Value = DateAdd("D", i, lastdate)
        Next ss
        
        For Each ss In .Range("c2:c" & .Cells(Rows.Count, "B").End(xlUp).Row)
            If InStr(ss.Value, "Manager") >= 1 Or InStr(ss.Value, "Team") >= 1 Then  'if color not grey then delete values except Team Manager/manager which is grey color
            Else
                ss.Resize(1, 6).Value = ""
            End If
    Next ss
    End With
Else
    Exit Sub
End If
   
Application.ScreenUpdating = True

End Sub

 

[GaryHealey]

Hi

Thank you for your help

Can you please advise how I can get the below macro to work as it just does one page and wont go to the next page?

Cheers

Gary

Sub NAMESROTA()
'
' NAMESROTA Macro
' CHANGE THE NAME ON THE ROTA
'

'Dim Sh As Worksheet
For Each Sh In Worksheets
With Sh
Windows("Rota NMEA Fiscal 2023 2024 MACRO TEST.xlsx").Activate
Range("B27").Select
ActiveCell.FormulaR1C1 = "John Smith"

Next Sh

End Sub

 

[RudRud]

Hi

Thank you for your help

Can you please advise how I can get the below macro to work as it just does one page and wont go to the next page?

Cheers

Gary

Sub NAMESROTA()
'
' NAMESROTA Macro
' CHANGE THE NAME ON THE ROTA
'

'Dim Sh As Worksheet
For Each Sh In Worksheets
With Sh
Windows("Rota NMEA Fiscal 2023 2024 MACRO TEST.xlsx").Activate
Range("B27").Select
ActiveCell.FormulaR1C1 = "John Smith"

Next Sh

End Sub

Hi @GaryHealey, I'm not sure your desire output. Maybe the other members inside forum can sort it out