如何从另一个工作簿运行宏答案

【问题标题】：How to run macro from another workbook如何从另一个工作簿运行宏
【发布时间】：2021-09-10 16:07:17
【问题描述】：

我在 workbook1 中有一个宏（代码如下）。我想在另一个工作簿上运行这个宏，但它不断打开工作簿 1 并在工作簿 1 中创建工作表。如果我将代码复制到另一个工作簿中，它工作正常，但我想从 workbook1 的另一个工作簿中运行宏。该宏将使用另一个工作簿数据在 workbook1 中创建一个工作表。如何使其在活动工作簿或其他工作簿中创建工作表。

Sub Pneumatic_Diagram()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim Machine As String
Dim iPnuematic As Integer
Dim iProject As Integer

Dim Lastrow As Long

Machine = Sheets("Project plan").Range("E4")
FileToOpen = "O:\060 Designs\06 All Pneumatic\Pneumatic_Tools\Pneumatic-Database2.xlsx"

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

'*** Delete define sheet name ***
For Each Sheet In ActiveWorkbook.Worksheets
     If Sheet.Name = "Pnumatic_Diagram" Then
          Sheet.Delete
     End If
Next Sheet

'**** Copy GN. from Projectplan****
Sheets("Project plan").Range("B:B").Copy
Sheets.Add(After:=Sheets("Follow up")).Name = "Pnumatic_Diagram"
Sheets("Pnumatic_Diagram").Range("L1").PasteSpecial xlPasteValues
Range("L:L").SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
Range("L:L").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

'**** Get data from data base****

If FileToOpen <> False Then

    Set OpenBook = Application.Workbooks.Open(FileToOpen)
    OpenBook.Sheets(Machine).Range("A:F").Copy
    
    With ThisWorkbook.Worksheets("Pnumatic_Diagram").Range("A1")
    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteFormats
    End With

    OpenBook.Close
    
End If

'**** Check data***

Cells(1, 7) = 1

For iPnuematic = 1 To Cells(Rows.Count, 2).End(xlUp).Row
    For iProject = 1 To Cells(Rows.Count, 12).End(xlUp).Row
        If Cells(iPnuematic, 1) = Cells(iProject, 12) Then
            Cells(iPnuematic, 7) = 1
        End If
    Next iProject
Next iPnuematic

'*** Delete GN. project plan ***
 Columns(12).EntireColumn.Delete
 
'*** Clear Data ***
For iPnuematic = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
    If Cells(iPnuematic, 7) <> 1 Then
        Rows(iPnuematic).EntireRow.Delete
    End If
Next iPnuematic

'*** Delete mark 1 ***
 Columns(7).EntireColumn.Delete
 
    With Application
       .EnableEvents = True
       .Calculation = xlCalculationAutomatic
       .ScreenUpdating = True
   End With


End Sub

【问题讨论】：

是否要将处理结果放入初始活动工作簿？

标签： excel vba

【解决方案1】：

请尝试替换此代码部分

'*** Delete define sheet name ***
For Each Sheet In ActiveWorkbook.Worksheets
     If Sheet.Name = "Pnumatic_Diagram" Then
          Sheet.Delete
     End If
Next Sheet

与

'your existing code...
'*** Delete define sheet name ***
'create a workbook variable to be set as ActiveWorkbook
Dim wbAct As Workbook: set wbAct = ActiveWorkbook
For Each Sheet In wbAct.Worksheets
     If Sheet.Name = "Pnumatic_Diagram" Then
          Sheet.Delete
     End If
Next Sheet
'your existing code

然后将ThisWorkbook替换为wbAct...

就像一般建议一样，最好完全限定所有使用的范围。例如Sheets("Project plan").Range("B:B").Copy 在活动工作簿上工作。为确保您的代码不会打开另一个工作簿，该工作簿将成为活动工作簿，您应该使用wbAct.Sheets("Project plan").Range("B:B").Copy。

并且对于代码在活动工作簿上工作的所有情况都执行相同的操作，当代码变得更复杂时可能会出现问题：Range("L:L")、Cells(1, 7)、Cells(iPnuematic, 1) 等。

【讨论】：