将工作表及其代码复制到另一个工作簿中

时间:2018-08-01 13:46:19

标签: excel vba copy-paste worksheet

我想将一个Excel工作表及其所有VBA代码从一个工作簿复制到另一个工作簿。每次尝试“移动或复制图纸”时,图纸副本都会被复制,但是没有VBA模块会转移到新工作簿中。有办法吗?

1 个答案:

答案 0 :(得分:0)

我过去曾经使用过类似的方法。你的旅费可能会改变。需要对其进行调整以引用两个不同的工作簿。尚未通过最新的MSOffice测试。我不知道它是否可以处理工作表对象中的代码。

Option Explicit
    Dim sExportLocation As String
    sExportLocation = "C:\myTempExport\" 'Do not forget the closing back slash! ie: C:\Temp\

Public Sub DoExportImport
    ExportTheModules
    ImportDatabaseObjects
End Sub    

Public Sub ExportTheModules
     '===============================================================================
     ' Name:    DocDatabase Purpose: Documents the database to a series of text files
     ' Author:  Arvin Meyer       ' Date:    June 02, 1999
     ' Comment: Uses the undocumented [Application.SaveAsText] syntax
     '          To reload use the syntax [Application.LoadFromText]
     '      Modified to set a reference to DAO 8/22/2005
     '===============================================================================
    Dim dbs As DAO.Database,  cnt As DAO.Container,  doc As DAO.Document

    Set cnt = dbs.Containers("Modules")
    For Each doc In cnt.Documents
        Application.SaveAsText acModule, doc.Name, sExportLocation & "Mods_" & doc.Name & ".txt"
    Next doc
End Sub

Public Sub ImportDatabaseObjects()
    On Error GoTo Err_ImportDatabaseObjects
    Dim db As Database      'Dim db As DAO.Database
    Dim td As TableDef, d As Document, c As Container  
    Set db = CurrentDb()

    Dim sFN As String, sName As String, sList() As Variant
    sList = Array("Module_", acModule)     ' Array("Module_", acModule, "Form_", acForm, "Query_", acQuery)
    sFN = Dir(sExportLocation & sList(0) & "*.txt")
    Do While sFN <> ""
        sName = Replace(sFN, sList(0), "")
        sName = Replace(sName, ".txt", "")
        Debug.Print sFN, , sName
        Application.LoadFromText sList(1), sName, sExportLocation & sFN
        sFN = Dir
    Loop

    Exit Sub

Err_ImportDatabaseObjects:
    MsgBox Err.Number & " - " & Err.Description
    Set c = Nothing
    db.Close
    Set db = Nothing    
End Sub