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

时间:2015-11-12 10:07:38

标签: excel vba excel-vba

我有一份Excel文档,其中包含52个每周时间表,每个时间表在一张单独的表格上,以及一个“当前”时间表,作为一个模板,可能会在整个学年中发生变化。我已经在52个时间表中创建了按钮,这些时间表通过进入当前模板并复制/粘贴我需要的范围进行自动填充,但是当它在一年中途发生变化并且你必须经历每一个TT时都会有点困难。从那时起,然后单击按钮。

我想要的是模板中的一个按钮,它填充所有52个TT,从某个星期开始(例如,'Week32'),通过模板中的数据验证下拉列表选择。因此,您可以选择要填写的周,单击按钮然后离开。

大部分代码都非常基本;我只是不知道从哪里开始从单元格中获取周名称并将其转换为指定的TT和跟随它的那些。每张TT表都被命名为“Week1”,“Week2”等,因此它们应该已经完全匹配下拉列表中的值,如果有帮助的话。

自动填充按钮我已经使用了以下代码(它们运行了六次;周一至周六)。任何改进建议欢迎:)

    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

[enter image description here]

1 个答案:

答案 0 :(得分:0)

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