如何从指定工作簿运行VBA宏并在活动/其他目标工作簿生成工作表

你当前的代码存在两个核心问题导致新工作表固定生成在存宏的Workbook1中：

• 未显式指定工作簿的Sheets/Range/Cells等对象，VBA默认指向代码所在的工作簿（即Workbook1）
• 代码中显式使用ThisWorkbook绑定宏所在文件，同时读取Project plan配置表的操作未绑定固定工作簿，切换活动工作簿后还会出现找不到表的报错

我们明确区分两类工作簿对象：宏所在的源工作簿（固定为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
' 新增变量：源工作簿（存宏的Workbook1）、目标工作簿（要生成新表的工作簿）、新建的工作表
Dim srcWB As Workbook, targetWB As Workbook
Dim newSht As Worksheet

' 绑定宏所在的Workbook1，固定不变
Set srcWB = ThisWorkbook
' 绑定目标工作簿，默认用当前活动工作簿；要指定其他已打开的工作簿可修改为 Set targetWB = Workbooks("指定的工作簿名.xlsx")
Set targetWB = ActiveWorkbook

' 从Workbook1的配置表读取参数，不受活动工作簿切换影响
Machine = srcWB.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

'*** 在目标工作簿中删除旧的同名工作表 ***
For Each Sheet In targetWB.Worksheets
     If Sheet.Name = "Pnumatic_Diagram" Then
          Sheet.Delete
     End If
Next Sheet

'**** 从Workbook1的Projectplan复制GN. ****
srcWB.Sheets("Project plan").Range("B:B").Copy
' 在目标工作簿中新建工作表
Set newSht = targetWB.Sheets.Add(After:=targetWB.Sheets("Follow up"))
newSht.Name = "Pnumatic_Diagram"
newSht.Range("L1").PasteSpecial xlPasteValues
' 所有工作表操作显式绑定到新建的表，避免操作错位
newSht.Range("L:L").SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
newSht.Range("L:L").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

'**** 从数据库获取数据 ****
If FileToOpen <> False Then
    Set OpenBook = Application.Workbooks.Open(FileToOpen)
    OpenBook.Sheets(Machine).Range("A:F").Copy
    
    ' 粘贴到目标工作簿的新表中，替换原有的ThisWorkbook绑定
    With newSht.Range("A1")
        .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        .PasteSpecial Paste:=xlPasteColumnWidths
        .PasteSpecial Paste:=xlPasteFormats
    End With
    OpenBook.Close
End If

'**** 校验数据 ***
newSht.Cells(1, 7) = 1
For iPnuematic = 1 To newSht.Cells(newSht.Rows.Count, 2).End(xlUp).Row
    For iProject = 1 To newSht.Cells(newSht.Rows.Count, 12).End(xlUp).Row
        If newSht.Cells(iPnuematic, 1) = newSht.Cells(iProject, 12) Then
            newSht.Cells(iPnuematic, 7) = 1
        End If
    Next iProject
Next iPnuematic

'*** 删除项目计划GN列 ***
newSht.Columns(12).EntireColumn.Delete
 
'*** 清理不匹配数据 ***
For iPnuematic = newSht.Cells(newSht.Rows.Count, 1).End(xlUp).Row To 1 Step -1
    If newSht.Cells(iPnuematic, 7) <> 1 Then
        newSht.Rows(iPnuematic).EntireRow.Delete
    End If
Next iPnuematic

'*** 删除标记列 ***
newSht.Columns(7).EntireColumn.Delete
 
With Application
   .EnableEvents = True
   .Calculation = xlCalculationAutomatic
   .ScreenUpdating = True
End With
End Sub

• 所有读取Project plan配置的操作都绑定到srcWB（即存宏的Workbook1），无论切换到哪个工作簿运行宏都能正常读取配置
• 目标工作簿默认取当前活动的工作簿，也可以直接修改targetWB的赋值语句指定固定工作簿，灵活适配需求
• 所有新建表、粘贴、遍历单元格的操作都显式绑定到目标工作簿的对应工作表，不会再误操作宏所在的Workbook1

内容的提问来源于stack exchange，提问作者armm