如何避免重复打开工作簿？VBA运行时错误1004问题求助

兄弟，我一眼就看出你代码里的问题了——你在循环里每次都打开同一个目标工作簿，这不报错才怪！先看看你遇到的具体错误：

Run-time Error '1004' - Method 'Open' of object 'Workbooks' failed.

同时弹出的提示也很明确：

"xxxx" is already open. reopening will cause any changes you made to be discarded. do you want to reopen "xxx.xlsx?"

问题根源 #

你的movedata过程里，Workbooks.Open("\\NMFPLPCLB130010\Users\stamarae\loglog.xlsx")这行代码放在了For i = 5 To LastRow循环内部。这意味着每处理一行数据，程序就会尝试打开一次目标工作簿。第一次打开后，后续循环再执行这个语句时，系统就会检测到文件已经处于打开状态，触发重复打开的提示，最终导致1004运行时错误。

另外，你的代码里还有个小语法错误：Dim语句里的l6 as variant Variant是重复定义，得删掉多余的Variant，不然也可能引发编译错误。

修复方案 #

核心思路是只打开目标工作簿一次，在循环开始前完成打开（或检查引用）操作，循环结束后再处理保存和关闭。具体步骤：

1. 先检查目标工作簿是否已经被打开，如果已经打开就直接获取引用，避免重复打开
2. 将打开工作簿的逻辑移到循环外部
3. 循环结束后，保存并关闭目标工作簿（如果不需要保持它打开的话）
4. 修复语法错误

修改后的完整代码 #

Sub movedata()
    Dim i As Long
    Dim LastRow As Long
    Dim wb As Workbook
    Dim wb2 As Workbook
    Dim L1 As Variant, L2 As Variant, L3 As Variant, L4 As Variant, L5 As Variant, L6 As Variant, L7 As Variant, L8 As Variant
    Dim sht1 As Worksheet
    Dim targetPath As String
    
    ' 定义目标工作簿路径，方便后续维护
    targetPath = "\\NMFPLPCLB130010\Users\stamarae\loglog.xlsx"
    
    Set wb = ThisWorkbook
    Set sht1 = wb.Sheets("PKG Avail Days")
    LastRow = sht1.Range("D:O").Find("*", SearchDirection:=xlPrevious).Row
    
    ' 先检查目标工作簿是否已经打开
    On Error Resume Next
    Set wb2 = Workbooks(Filename:=targetPath)
    On Error GoTo 0
    
    ' 如果没打开，就打开它
    If wb2 Is Nothing Then
        Set wb2 = Workbooks.Open(targetPath)
    End If
    
    ' 循环处理数据（只在循环内写入，不再重复打开）
    For i = 5 To LastRow
        L1 = sht1.Range("D" & i).Value
        L2 = sht1.Range("E" & i).Value
        L3 = sht1.Range("F" & i).Value
        L4 = sht1.Range("K" & i).Value
        L5 = sht1.Range("L" & i).Value
        L6 = sht1.Range("M" & i).Value
        L7 = sht1.Range("N" & i).Value
        L8 = sht1.Range("O" & i).Value
        
        ' 获取目标工作表的最后一行，避免重复计算
        Dim targetLastRow As Long
        targetLastRow = wb2.Sheets(1).Range("D" & Rows.Count).End(xlUp).Row + 1
        
        ' 一次性写入整行数据，比逐个单元格写入效率更高
        wb2.Sheets(1).Range("D" & targetLastRow & ":K" & targetLastRow).Value = Array(L1, L2, L3, L4, L5, L6, L7, L8)
    Next i
    
    ' 保存并关闭目标工作簿（如果不需要保持打开，就保留这两行）
    wb2.Save
    wb2.Close SaveChanges:=False ' 已经Save过，这里设为False也可以
    
    ' 释放对象引用，养成良好习惯
    Set wb2 = Nothing
    Set sht1 = Nothing
    Set wb = Nothing
End Sub

额外优化点 #

我还给你加了两个实用优化：

• 一次性写入整行数据（用Array和Range.Value），比逐个单元格写入效率高很多，尤其是数据量较大的时候
• 提前获取目标工作表的最后一行，避免每次写入都重复计算Rows.Count

这样修改后，就不会再出现重复打开工作簿的问题，1004错误也会消失啦！

内容的提问来源于stack exchange，提问作者s.amason