Question

我的excel文件中有7张纸，我需要一次全部复制。我创建了一个按钮，使用下面显示的代码执行此操作。但是，我还希望能够在复制纸张时清除某些单元格。我试图修改另一本工作簿中的第二组代码，该工作簿一次复制一页并清除单元格，但我似乎无法使其正常工作。该代码不需要像下面的代码那样搜索最近一周，我只需要复制7张纸并清除2至7页上的单元格G18：G37。谢谢

“我现在有什么。”

Private Sub CommandButton1_Click()

Worksheets(Array("Coding Details", "Schedule A", "Schedule B", "Schedule C", "Schedule D", "Schedule E", "Schedule F")).Copy After:=Worksheets(Worksheets.Count)

End Sub

“我在其他工作簿中使用的内容”

Private Sub CommandButton1_Click()

Dim wrkSht As Worksheet
Dim lWkNum As Long
Dim lCurNum As Long
Dim sht_LastWeek As Worksheet
Dim sht_NewWeek As Worksheet

'Find previous week and set reference to it.
For Each wrkSht In ThisWorkbook.Worksheets
    If IsNumeric(Replace(wrkSht.Name, "Week ", "")) Then
        lCurNum = CLng(Replace(wrkSht.Name, "Week ", ""))
        If lCurNum > lWkNum Then lWkNum = lCurNum
    End If
Next wrkSht
Set sht_LastWeek = ThisWorkbook.Worksheets("Week " & lWkNum)

'Create new sheet, set reference to it and rename.
sht_LastWeek.Copy After:=Sheets(sht_LastWeek.Index)
Set sht_NewWeek = Sheets(sht_LastWeek.Index + 1)
sht_NewWeek.Name = "Week " & lCurNum + 1

'Clear the cells and relink formula to previous sheet.
With sht_NewWeek
    .Range("B40:J45,C18:I21,E26:F31").ClearContents
    .Cells.Replace What:="'Week " & lCurNum - 1 & "'!", _
                   Replacement:="'Week " & lCurNum & "'!", _
                   LookAt:=xlPart
End With

End Sub

Answer 1

这应该有效：

Private Sub CommandButton1_Click()

    Dim n As Long, wb As Workbook

    Set wb = ThisWorkbook

    wb.Worksheets(Array("Coding Details", "Schedule A", "Schedule B", _
                    "Schedule C", "Schedule D", "Schedule E", "Schedule F")).Copy _
                    After:=wb.Worksheets(wb.Worksheets.Count)
    For n = 0 To 5
        wb.Worksheets(wb.Worksheet.Count - n).Range("G18:G37").ClearContents
    Next n


End Sub

复制多页并清除单元格

1 个答案: