VBA按国家筛选拆分数据保存时报运行时错误1004如何解决

核心错误根源 #

你遇到的运行时错误1004主要由以下几个代码问题导致：

run-time error 1004 its sorry we couldn't find... or microsoft can't access the file

• 路径拼接错误：原代码中保存路径末尾缺少反斜杠，且OneDrive - 后缺少对应组织/账户名称，拼接后的路径实际不存在
• 路径未提前创建：VBA不会自动生成不存在的文件夹，目标文件夹不存在时会直接触发报错
• 文件名重复：循环筛选不同国家时都使用同一个ID作为文件名，会出现同名文件覆盖、写入冲突
• 范围未绑定工作表：ID = Range("a2")、高级筛选的输出范围都未绑定Master表，当前激活表变化时会出现取值错误
• 保存格式不匹配：新建的空白工作簿默认无宏，直接保存为xlsm格式会触发格式兼容性错误

修正后代码 #

Sub 按国家拆分数据()
    Application.ScreenUpdating = False
    Dim x As Range
    Dim rng As Range
    Dim last As Long
    Dim sht As String
    Dim ID As String
    Dim savePath As String
    
    ' -------------------------- 请先修改此处参数 --------------------------
    ' 请补全下面OneDrive后的组织名，确保路径真实存在，末尾必须加反斜杠
    savePath = Environ("userprofile") & "\OneDrive - 你的组织名称\Desktop\VBA macro\split by country\"
    ' ----------------------------------------------------------------------
    
    ' 所有范围明确绑定Master表，避免激活表变化出错
    sht = "Master"
    With Sheets(sht)
        ID = .Range("A2").Value ' 明确从Master表取A2的ID
        last = .Cells(.Rows.Count, "H").End(xlUp).Row
        Set rng = .Range("A1:Y" & last)
        
        ' 高级筛选唯一国家值输出到当前表的AA列
        .Range("H1:H" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("AA1"), Unique:=True
    End With
    
    ' 遍历所有唯一国家执行拆分
    For Each x In Sheets(sht).Range(Sheets(sht).Range("AA2"), Sheets(sht).Cells(Sheets(sht).Rows.Count, "AA").End(xlUp))
        rng.AutoFilter Field:=8, Criteria1:=x.Value
        rng.SpecialCells(xlCellTypeVisible).Copy
        
        ' 新建工作簿粘贴筛选结果
        Dim newWb As Workbook
        Set newWb = Workbooks.Add
        newWb.Sheets(1).Paste
        
        ' 文件名拼接：国家名+ID避免重复，保存为xlsm格式时明确指定格式参数
        newWb.SaveAs Filename:=savePath & x.Value & "_" & ID & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
        newWb.Close SaveChanges:=False
    Next x
    
    ' 清理重置环境
    Sheets(sht).AutoFilterMode = False
    Sheets(sht).Columns("AA:AA").Delete ' 清理临时生成的唯一值列
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
    MsgBox "数据拆分完成！"
End Sub

使用前注意事项 #

1. 先把代码中savePath里的你的组织名称替换成你OneDrive路径里实际的名称，可以打开OneDrive下的桌面文件夹，复制地址栏的路径替换即可
2. 提前手动确认路径下的VBA macro\split by country文件夹已经存在，不存在的话先手动创建
3. 如果不需要保存宏文件，可以把后缀名改成xlsx，对应的FileFormat参数改成xlOpenXMLWorkbook即可

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