VBA代码可打开指定工作簿但无法复制数据至目标工作表求助

核心问题定位 #

你的代码存在语法错误，会直接导致程序运行中断，无法完成数据复制操作：
在易腐品LTO数据处理段，这行代码缺少算术运算符（如-或+）：

targetSheet.Range("C102").Value = sourceSheetPerLTO.Range("J10").Value sourceSheetPerLTO.Range("J7").Value

程序执行到此处会触发报错并终止，后续代码无法运行，甚至前面的赋值操作也可能因中断未生效。

其他潜在问题排查 #

除语法错误外，以下场景也可能导致数据复制失败：

• 工作表索引不匹配：你用Worksheets(2)、Worksheets(9)这类索引调用工作表，若源工作簿的工作表顺序调整、存在隐藏工作表，或工作表数量不足，会触发对象引用错误，中断程序。建议改用工作表名称（如Worksheets("食品杂货销售")），避免依赖索引顺序。
• 未处理文件选择取消场景：若用户在文件选择对话框点击「取消」，customerFilename会返回False，此时执行Workbooks.Open会直接报错。需增加判断逻辑：

  If customerFilename = False Then Exit Sub
  

• 目标工作表定位错误：targetWorkbook.Worksheets(1)指向目标工作簿的第一个工作表，若你需要写入的不是第一个表，会导致数据写入错误位置，看起来像“未复制”。
• 源单元格为空或格式问题：若源单元格本身无数据，或单元格格式为特殊文本格式，赋值后可能显示为空，可检查源单元格的实际内容。

修复后的完整代码示例 #

修复语法错误并增加必要判断后的代码：

Sub Automated_Fill()
    Dim filter As String
    Dim caption As String
    Dim customerFilename As Variant ' 改用Variant接收返回值，兼容取消选择的情况
    Dim customerWorkbook As Workbook
    Dim targetWorkbook As Workbook

    Set targetWorkbook = Application.ActiveWorkbook

    filter = "Excel文件 (*.xlsx),*.xlsx"
    caption = "请选择输入文件 "
    customerFilename = Application.GetOpenFilename(filter, , caption)

    ' 处理用户取消选择的情况
    If customerFilename = False Then Exit Sub

    Set customerWorkbook = Application.Workbooks.Open(customerFilename)
    Application.ScreenUpdating = False ' 关闭屏幕刷新，提升运行速度

    Dim targetSheet As Worksheet
    Set targetSheet = targetWorkbook.Worksheets(1) ' 建议改为具体工作表名称，如Worksheets("目标表")

    ' 食品杂货数据
    Dim sourceSheetGroSel As Worksheet
    Set sourceSheetGroSel = customerWorkbook.Worksheets(2) ' 建议改用工作表名称
    targetSheet.Range("C9").Value = sourceSheetGroSel.Range("J8").Value
    targetSheet.Range("C17").Value = sourceSheetGroSel.Range("K8").Value

    Dim sourceSheetGroLoad As Worksheet
    Set sourceSheetGroLoad = customerWorkbook.Worksheets(3)
    targetSheet.Range("C10").Value = sourceSheetGroLoad.Range("J5").Value
    targetSheet.Range("C11").Value = 0
    targetSheet.Range("C18").Value = sourceSheetGroLoad.Range("K5").Value
    targetSheet.Range("C19").Value = 0

    Dim sourceSheetGroLTO As Worksheet
    Set sourceSheetGroLTO = customerWorkbook.Worksheets(4)
    targetSheet.Range("C12").Value = sourceSheetGroLTO.Range("J12").Value - sourceSheetGroLTO.Range("J8").Value - sourceSheetGroLTO.Range("J9").Value
    targetSheet.Range("C13").Value = 0
    targetSheet.Range("C20").Value = sourceSheetGroLTO.Range("K12").Value
    targetSheet.Range("C21").Value = 0
    targetSheet.Range("G12").Value = sourceSheetGroLTO.Range("J8").Value + sourceSheetGroLTO.Range("J9").Value

    Dim sourceSheetGroRec As Worksheet
    Set sourceSheetGroRec = customerWorkbook.Worksheets(5)
    targetSheet.Range("G13").Value = sourceSheetGroRec.Range("J5").Value
    targetSheet.Range("G21").Value = sourceSheetGroRec.Range("K5").Value

    ' 易腐品数据
    Dim sourceSheetPerSel As Worksheet
    Set sourceSheetPerSel = customerWorkbook.Worksheets(6)
    targetSheet.Range("G99").Value = sourceSheetPerSel.Range("J10").Value
    targetSheet.Range("G107").Value = sourceSheetPerSel.Range("K10").Value

    Dim sourceSheetPerLoad As Worksheet
    Set sourceSheetPerLoad = customerWorkbook.Worksheets(7)
    targetSheet.Range("G100").Value = sourceSheetPerLoad.Range("J5").Value
    targetSheet.Range("G108").Value = sourceSheetPerLoad.Range("J5").Value

    Dim sourceSheetPerLTO As Worksheet
    Set sourceSheetPerLTO = customerWorkbook.Worksheets(9)
    ' 修复语法错误，此处假设是减法，可根据实际需求修改运算符
    targetSheet.Range("C102").Value = sourceSheetPerLTO.Range("J10").Value - sourceSheetPerLTO.Range("J7").Value
    targetSheet.Range("G102").Value = sourceSheetPerLTO.Range("J7").Value
    targetSheet.Range("C110").Value = sourceSheetPerLTO.Range("K10").Value

    Dim sourceSheetPerRec As Worksheet
    Set sourceSheetPerRec = customerWorkbook.Worksheets(8)
    targetSheet.Range("C103").Value = sourceSheetPerRec.Range("J5").Value
    targetSheet.Range("C111").Value = sourceSheetPerRec.Range("K5").Value

    ' 冷冻品数据
    Dim sourceSheetFrzSel As Worksheet
    Set sourceSheetFrzSel = customerWorkbook.Worksheets(10)
    targetSheet.Range("C144").Value = sourceSheetFrzSel.Range("J6").Value
    targetSheet.Range("C152").Value = sourceSheetFrzSel.Range("K6").Value

    Dim sourceSheetFrzLTO As Worksheet
    Set sourceSheetFrzLTO = customerWorkbook.Worksheets(11)
    targetSheet.Range("C147").Value = sourceSheetFrzLTO.Range("J5").Value
    targetSheet.Range("G147").Value = sourceSheetFrzLTO.Range("J4").Value
    targetSheet.Range("C155").Value = sourceSheetFrzLTO.Range("J5").Value
    targetSheet.Range("G155").Value = sourceSheetFrzLTO.Range("J4").Value

    Dim sourceSheetFrzRec As Worksheet
    Set sourceSheetFrzRec = customerWorkbook.Worksheets(12)
    targetSheet.Range("G148").Value = sourceSheetFrzRec.Range("J5").Value
    targetSheet.Range("G156").Value = sourceSheetFrzRec.Range("K5").Value

    ' 关闭客户工作簿，不保存更改
    customerWorkbook.Close SaveChanges:=False
    Application.ScreenUpdating = True
End Sub

验证步骤 #

1. 修复语法错误后，按F5运行宏，观察是否还会报错。
2. 检查源工作簿的工作表数量、顺序是否与代码中的索引匹配，或改用工作表名称避免索引依赖。
3. 确认目标工作表的位置是否正确，避免写入错误的工作表。

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