Excel VBA - 将工作簿复制到包含宏的新工作簿中

时间:2017-07-24 07:45:30

标签: excel vba excel-vba

所以我有一个工作表,使用其他2个工作表的信息生成图表类型的东西。在它上面我有一个提取按钮,它应该将整个工作簿复制到一个新的工作簿中,同时使数据被拉出的工作表对用户不可见。我的问题是,图表工作表有其他功能需要运行宏,例如隐藏其中的一些按钮等。问题是我无法找到它是否真的可以通过宏从工作簿复制到新复制的工作簿?任何人都有这个答案,如果是这样,你会怎么做?以下是我目前拥有的将工作簿复制到新工作簿中的代码:

Sub EWbtn()

Dim OriginalWB As Workbook, NewCRCWB As Workbook

Set OriginalWB = ThisWorkbook
Set NewCRCWB = Workbooks.Add


OriginalWB.Sheets("Generator").Copy Before:=NewCRCWB.Sheets("Sheet1")
OriginalWB.Sheets("Module Part Number Tracker").Copy Before:=NewCRCWB.Sheets("Generator")
OriginalWB.Sheets("CRC").Copy Before:=NewCRCWB.Sheets("Module Part Number Tracker")

Application.DisplayAlerts = False
NewCRCWB.Worksheets("Generator").Visible = False
NewCRCWB.Worksheets("Module Part Number Tracker").Visible = False
NewCRCWB.Worksheets("Sheet1").Delete
Application.DisplayAlerts = True

End Sub

2 个答案:

答案 0 :(得分:0)

我设法找到了我的问题的答案..此代码工作正常,但您需要添加" Microsoft Visual Basic for Applications Extensibility 5.x"作为工具的参考 - >引用。这是代码:

Dim src As CodeModule, dest As CodeModule

Set src = ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
Set dest = Workbooks("Book3").VBProject.VBComponents("ThisWorkbook") _
.CodeModule

dest.DeleteLines 1, dest.CountOfLines
dest.AddFromString src.Lines(1, src.CountOfLines)

信用:Copy VBA code from a Sheet in one workbook to another?

答案 1 :(得分:0)

我要复印一份原始文件并从中删除/隐藏工作表 所有代码都将作为保存的一部分进行复制。

Sub Test()

    Dim wrkBk As Workbook
    Dim sCopyFileName As String
    Dim wrkSht As Worksheet

    sCopyFileName = "C:\MyFolderPaths\Book2.xlsm"

    'Create copy of original file and open it.
    ThisWorkbook.SaveCopyAs (sCopyFileName)
    Set wrkBk = Workbooks.Open(sCopyFileName)

    'wrkbk.Worksheets does not include Chart sheets.
    'wrkbk.Sheets would take into account all the types of sheet available.
    For Each wrkSht In wrkBk.Worksheets
        Select Case wrkSht.Name
            Case "Generator", "Module Part Number Tracker"
                wrkSht.Visible = xlSheetVeryHidden
            Case "CRC"
                'Do nothing, this sheet is left visible.
            Case Else
                Application.DisplayAlerts = False
                wrkSht.Delete
                Application.DisplayAlerts = True
        End Select
    Next wrkSht

    wrkBk.Close SaveChanges:=True

End Sub