根据单元格值将范围粘贴到不同的工作表中

Question

I have an Excel document that contains 52 weekly timetables each on a separate sheet, and a 'current' timetable, which acts as a template which may change throughout the academic year. I've created buttons in each of the 52 timetables that autofill by going into the Current template and copying/pasting the ranges I need, but it's a bit of a slog when it changes halfway through the year and you have to go through every TT from that point on and click the button.

What I'd like instead is a button within the template that fills all 52 TTs, beginning on a certain week (eg, 'Week32') which is selected via a data validation drop-down within the template. So you would select the week you want to fill from, click the button and away it goes.

Most of the code is pretty basic; I just don't know where to start with getting the week name from the cell and translating that to getting to the specified TT and those following it. Each TT sheet is named 'Week1', 'Week2' etc so they should already be an exact match for the values in the drop-down, if that helps.

The autofill buttons I have already use the following code (they run this six times; Mon-Sat). Any suggestions for improvement welcome :)

    Sub Fillsheet10()
'
' Fillsheet10 Macro

    Sheets("CurrentSheet").Select
    Range("A3:A5").Select
    Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Week10").Select
    Range("C3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

[ ]

Answer 1

you can update one sheet usisng:

Sub UpdSheet()
wk = Range("F10")  ' in your example Week31

Sheets("CurrentSheet").Select
Range("A3:A5").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Application.CutCopyMode = False
Selection.Copy

Sheets(wk).Select
Range("C3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
......
End Sub

or you can update all sheet when the nr. week is >= to the first you will to modify tips: to modify all sheets your first week will be 1

Sub UpdAllSheet()
Dim ws As Worksheet
Dim wk As Integer

Sheets("CurrentSheet").Select
Range("A3:A5").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Application.CutCopyMode = False
Selection.Copy

wk = Range("F10")  ' now you do only imput 31
For Each ws In ActiveWorkbook.Worksheets
    wknr = Replace(ws.Name, "Week", "")
    If wknr >= wk Then
        UpdSheet (ws.Name)
    End If
Next
End Sub