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

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

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选项卡表名称与Visual Basic表名称

我build议是声明你的表，当你创build它，并写...VBComponents(TheNameYouDeclared.CodeName).CodeModule

你给我们的代码加上我build议给你的代码：

 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

创build一个包含您需要的代码的模板工作表 – 然后复制这个来创build您的新工作表。

在我的代码中，我使用了模板表的代号，而不是在标签上显示的名字（可以在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