基于动态列表的多工作簿数据拉取VBA代码优化需求

原代码因硬编码固定单元格路径，遇到空单元格会触发错误，以下是修改后的代码，实现遍历Sheet5!C3:C20区域，仅处理非空单元格的路径，同时对应同一行S列的工作表名，按顺序将数据写入Backend2工作表的A2、C2、E2等位置：

Sub AllocationPull()
    Dim wkbSource As Excel.Workbook
    Dim wksTarget As Excel.Worksheet
    Dim cell As Range
    Dim targetCol As Integer
    Dim wsName As String
    
    Application.ScreenUpdating = False
    Set wksTarget = ThisWorkbook.Worksheets("Backend2")
    targetCol = 1 ' 初始目标列：A列
    
    ' 遍历C3:C20区域的每个单元格
    For Each cell In Sheet5.Range("C3:C20")
        ' 跳过空单元格
        If Trim(cell.Value) <> "" Then
            wsName = Trim(cell.Offset(0, 16).Value) ' 获取同一行S列的工作表名（C到S偏移16列）
            ' 错误处理：防止路径无效或工作表不存在
            On Error Resume Next
            Set wkbSource = Excel.Workbooks.Open(cell.Value)
            If Err.Number <> 0 Then
                MsgBox "无法打开文件：" & cell.Value & vbCrLf & "错误信息：" & Err.Description
                On Error GoTo 0
                GoTo NextCell
            End If
            
            If Not wsName = "" Then
                ' 检查工作表是否存在
                On Error Resume Next
                Dim wksSource As Excel.Worksheet
                Set wksSource = wkbSource.Worksheets(wsName)
                If Err.Number <> 0 Then
                    MsgBox "文件" & cell.Value & "中不存在工作表：" & wsName
                    wkbSource.Close SaveChanges:=False
                    On Error GoTo 0
                    GoTo NextCell
                End If
                ' 复制数据到目标工作表对应列
                wksSource.Range("A1:B30").Copy Destination:=wksTarget.Cells(2, targetCol)
            Else
                MsgBox "文件" & cell.Value & "对应的工作表名为空（行" & cell.Row & "的S列）"
            End If
            
            ' 关闭源工作簿，不保存
            wkbSource.Close SaveChanges:=False
            On Error GoTo 0
            ' 目标列后移2列（因为每次复制A:B两列）
            targetCol = targetCol + 2
        End If
NextCell:
    Next cell
    
    Application.ScreenUpdating = True
    MsgBox "数据拉取完成！"
End Sub

关键改动说明 #

• 循环遍历动态区域：用For Each遍历C3:C20，通过Trim(cell.Value) <> ""过滤空单元格，避免无效路径报错
• 动态关联工作表名：利用cell.Offset(0,16)获取同一行S列的工作表名，无需硬编码每个单元格位置
• 目标列自动偏移：用targetCol变量记录当前写入的起始列，每处理一个有效文件就加2，对应原代码中A2→C2→E2的布局
• 错误处理机制：添加路径无效、工作表不存在的错误捕获，弹出提示并跳过异常项，保证代码能继续执行
• 简化对象声明：去掉大量重复的wkbX、wksX变量，改用循环内的临时对象，代码更简洁易维护

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