Question

我正在尝试编写一个代码来创建另一个工作表并粘贴第二个工作表的代码，如果工作表已经存在，该程序也将删除该工作表

Application.DisplayAlerts = False
Sheets("Calcs").Delete
Application.DisplayAlerts = True

With ThisWorkbook
        .Sheets.Add(after:=.Sheets(.Sheets.Count)).Name = "Calcs"
End With

Dim CodeCopy As VBIDE.CodeModule
Dim CodePaste As VBIDE.CodeModule
Dim numLines As Integer

Set CodeCopy = ActiveWorkbook.VBProject.VBComponents("Sheet2").CodeModule
Set CodePaste = ActiveWorkbook.VBProject.VBComponents("Calcs").CodeModule

numLines = CodeCopy.CountOfLines

CodePaste.AddFromString CodeCopy.Lines(1, numLines)

不工作，我不知道为什么

Answer 1

我认为由于你的表单名称而无效。在VBA项目窗口中，您可以看到工作表有两个名称： Sheet1（Sheet1）。因此，当您添加工作表并重命名时，名称将为Sheet ##（Calcs），但是当您编写ActiveWorkbook.VBProject.VBComponents("Calcs").CodeModule时，您需要使用“Sheet ##”，这是代号而不是“Calcs”。这里有更好的解释： Excel tab sheet names vs. Visual Basic sheet names

我建议您在创建工作表时声明工作表并编写...VBComponents(TheNameYouDeclared.CodeName).CodeModule

您给我们的代码加上我的建议给您：

Application.DisplayAlerts = False
Sheets("Calcs").Delete
Application.DisplayAlerts = True

With ThisWorkbook
        .Sheets.Add(after:=.Sheets(.Sheets.Count)).Name = "Calcs"
End With

Dim MySheet As Worksheet
Set MySheet = ThisWorkbook.Sheets("Calcs")

Dim CodeCopy As String
Dim CodePaste As String
Dim numLines As Integer

CodeCopy = ActiveWorkbook.VBProject.VBComponents("Sheet1").CodeModule
CodePaste = ActiveWorkbook.VBProject.VBComponents(MySheet.CodeName).CodeModule

numLines = CodeCopy.CountOfLines

CodePaste.AddFromString CodeCopy.Lines(1, numLines)

它适合你吗？

Answer 2

创建包含所需代码的模板工作表 - 然后只需将其复制以创建新工作表。

在我的代码中，我使用了模板表的代号而不是选项卡上显示的名称（可以在VBE之外进行更改） - 这个名称不在Microsoft Excel Objects的括号中，可以是已使用(Name)标签中的Properties媒体资源进行了更新。

Sub Test()

    If WorkSheetExists("Calcs") Then
        Application.DisplayAlerts = False
        ThisWorkbook.Worksheets("Calcs").Delete
        Application.DisplayAlerts = True
    End If

    With shtTemplate 'Use codename rather than actual name.
        .Visible = xlSheetVisible
        .Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        .Visible = xlSheetVeryHidden
    End With

    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = "Calcs"

End Sub

Public Function WorkSheetExists(SheetName As String, Optional WrkBk As Workbook) As Boolean
    Dim wrkSht As Worksheet

    If WrkBk Is Nothing Then
        Set WrkBk = ThisWorkbook
    End If

    On Error Resume Next
        Set wrkSht = WrkBk.Worksheets(SheetName)
        WorkSheetExists = (Err.Number = 0)
        Set wrkSht = Nothing
    On Error GoTo 0
End Function

将代码从一张纸复制到另一张

2 个答案: