Question

我使用以下VBA按钮创建一个新的每周4张时间表，清除相应的数据并更改新的。

我正在努力从目前的表格Cell I42转移到新表I39。任何人都可以让我知道我哪里出错了。

由于

Sub NewTimesheet()
    Dim wsToCopy As Worksheet, wsNew As Worksheet

    On Error GoTo Whoa:

    Set wsToCopy = ThisWorkbook.ActiveSheet
    Set wsNew = ThisWorkbook.Sheets.Add

    wsToCopy.Cells.Copy wsNew.Cells

    wsNew.Range("C7:H13").ClearContents
    wsNew.Range("C15:H21").ClearContents
    wsNew.Range("C23:H29").ClearContents
    wsNew.Range("C31:H37").ClearContents
    wsNew.Range("K7:M13").ClearContents
    wsNew.Range("K15:M21").ClearContents
    wsNew.Range("K23:M29").ClearContents
    wsNew.Range("K31:M37").ClearContents
    wsNew.Range("J42").ClearContents
    wsNew.Range("A7").Value = ActiveSheet.Range("A37").Value + 1
    wsNew.Range("I39").ClearContents
    wsNew.Range("J39").ClearContents
    ActiveSheet.Name = Range("A7").Text
    ActiveSheet.Range("I43").Copy wsNew.Range("I39").Value


    Exit Sub
Whoa:
    MsgBox Err.Description
End Sub

Answer 1

认为你可以稍微缩短你的代码。顺便说一句，我不认为将代码基于活动工作表是一个非常好的主意，以防在不同工作表无意中激活时运行。

Sub NewTimesheet()

    Dim wsToCopy As Worksheet, wsNew As Worksheet

    On Error GoTo Whoa:

    Set wsToCopy = ThisWorkbook.ActiveSheet
    wsToCopy.Copy after:=Sheets(Sheets.Count)
    Set wsNew = ActiveSheet

    With wsNew
        .Range("C7:H13,C15:H21,C23:H29,C31:H37,K7:M13,K15:M21,K23:M29,K31:M37,J42").ClearContents
        .Range("A7").Value = wsToCopy.Range("A37").Value + 1
        .Range("I39:J39").ClearContents
        .Name = wsToCopy.Range("A7").Text 'not sure which sheet this should be
        .Range("I39").Value = wsToCopy.Range("I43").Value
    End With

    Exit Sub
Whoa:
    MsgBox Err.Description

End Sub

Answer 2

正如我在评论中所述，由于您已经使用wsToCopy和wsNew设置了两张表，为什么还需要使用ActiveSheet？

尽管如此，这似乎对我有用。

Sub NewTimesheet()
    Dim wsToCopy As Worksheet, wsNew As Worksheet

    On Error GoTo Whoa:

    Set wsToCopy = ThisWorkbook.ActiveSheet
    Set wsNew = ThisWorkbook.Sheets.Add

    wsToCopy.Cells.Copy wsNew.Cells

    With wsNew
        .Range("C7:H13").ClearContents
        .Range("C15:H21").ClearContents
        .Range("C23:H29").ClearContents
        .Range("C31:H37").ClearContents
        .Range("K7:M13").ClearContents
        .Range("K15:M21").ClearContents
        .Range("K23:M29").ClearContents
        .Range("K31:M37").ClearContents
        .Range("J42").ClearContents
        .Range("A7").Value = wsToCopy.Range("A37").Value + 1
        .Range("I39").ClearContents
        .Range("J39").ClearContents
        .Name = .Range("A7").Text
        wsToCopy.Range("I43").Copy .Range("I39")
    End With


    Exit Sub
Whoa:
    MsgBox Err.Description
End Sub

复制时间表VBA

2 个答案: