Excel VBA如何为指定工作簿、工作表重复执行操作无需复制代码

你可以通过参数数组+循环的方式实现逻辑复用，不需要重复编写复制粘贴的代码段，新增要处理的工作表仅需要补充数组参数即可，优化后代码如下：

Sub CopyPastefromOtherWB()
    ' 提前定义常量，修改路径时只需改一处
    Const BASE_PATH As String = "C:\Users\Desktop\My macro projects\"
    Dim outputWB As Workbook, sourceWB As Workbook
    Dim wsOut As Worksheet, wsSource As Worksheet
    Dim marCol As Range
    ' 这里定义任务数组：每组参数为 源工作簿名, 源工作表名, 粘贴目标列号
    Dim taskList As Variant
    taskList = Array( _
        Array("Red", "Apple", 2), _ ' 2对应B列
        Array("Yellow", "Banana", 3) _ ' 3对应C列，新增任务直接在这里加行即可
    )
    Dim task As Variant, i As Integer
    
    ' 提前打开输出工作簿，不用每次重复打开
    Set outputWB = Workbooks.Open(Filename:=BASE_PATH & "OutputWB")
    Set wsOut = outputWB.Worksheets("Sheet1")
    
    ' 循环遍历所有任务
    For Each task In taskList
        ' 打开源工作簿
        Set sourceWB = Workbooks.Open(Filename:=BASE_PATH & task(0))
        Set wsSource = sourceWB.Worksheets(task(1))
        
        ' 查找Mar所在列，避免用Select/Activate提高效率和稳定性
        Set marCol = wsSource.Rows(1).Find(What:="Mar", LookIn:=xlValues, LookAt:=xlWhole)
        If Not marCol Is Nothing Then
            ' 复制Mar列从第二行开始的所有数据
            wsSource.Range(marCol.Offset(1, 0), marCol.End(xlDown)).Copy
            ' 粘贴到输出表对应列的13行
            wsOut.Cells(13, task(2)).PasteSpecial Paste:=xlPasteValues
        End If
        ' 关闭源工作簿，不保存
        sourceWB.Close SaveChanges:=False
    Next task
    
    ' 清理剪贴板
    Application.CutCopyMode = False
End Sub

核心优化点 #

• 把所有可变的参数都存到taskList数组里，后续要新增处理的工作表，只需要在数组里新增一行Array("工作簿名", "工作表名", 粘贴列号)即可，不需要修改逻辑代码
• 去掉了所有Select/Activate操作，直接通过对象引用操作表格，避免界面跳转卡顿、误操作的问题
• 输出工作簿只打开一次，不需要每次粘贴都重复打开，运行效率更高
• 增加了Mar字段的存在性判断，避免找不到对应字段时代码报错
• 用完的源工作簿自动关闭，不会留下大量隐藏打开的工作簿占用内存

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