如何将Excel命名区域数据复制到存储在SharePoint的另一工作簿？

原代码问题排查 #

• 路径末尾多余空格：填写的SharePoint路径末尾多了一个空格，会导致程序无法正确定位到工作簿B，抛出文件不存在错误
• 工作表引用语法错误：openWb("sheet1")是错误写法，工作簿对象调用工作表需要用Worksheets属性，正确写法为openWb.Worksheets("Sheet1")
• 命名区域引用冗余：如果三个命名区域是工作簿级命名区域（绝大多数情况命名区域默认都是工作簿级），不需要指定工作表，直接通过工作簿对象调用Range即可
• 缺少保存/关闭逻辑：赋值完成后没有执行保存操作，修改的内容不会同步到SharePoint的工作簿B中
• 变量名语义混淆：原代码定义的sourceWb实际是目标工作簿B，变量名和实际用途相反，容易引发后续维护错误

修正后代码 #

Sub CopyNamedRangesToSharePoint()
    Dim wbSourceA As Workbook ' 当前运行代码的工作簿A
    Dim wbTargetB As Workbook ' SharePoint存储的工作簿B
    Dim arrRangeNames As Variant
    Dim rangeName As Variant
    
    ' 初始化对象
    Set wbSourceA = ThisWorkbook
    ' 注意替换为你实际的SharePoint路径，删除路径前后多余空格
    Set wbTargetB = Workbooks.Open(Filename:="https://SharePointLocationToWorkbookB.xlsm", ReadOnly:=False, UpdateLinks:=False)
    
    ' 预定义需要复制的命名区域，后续增删只需要改这个数组即可
    arrRangeNames = Array("Alpha", "Beta", "Charlie")
    
    ' 循环批量复制数值
    For Each rangeName In arrRangeNames
        ' 确保两个工作簿的命名区域尺寸一致再赋值，避免部分区域漏赋值
        If wbSourceA.Range(rangeName).Rows.Count = wbTargetB.Range(rangeName).Rows.Count And _
        wbSourceA.Range(rangeName).Columns.Count = wbTargetB.Range(rangeName).Columns.Count Then
            wbTargetB.Range(rangeName).Value = wbSourceA.Range(rangeName).Value
        Else
            ' 尺寸不一致时仅覆盖目标区域的对应有效范围
            wbTargetB.Range(rangeName).Resize(wbSourceA.Range(rangeName).Rows.Count, _
            wbSourceA.Range(rangeName).Columns.Count).Value = wbSourceA.Range(rangeName).Value
        End If
    Next rangeName
    
    ' 保存修改并关闭目标工作簿
    wbTargetB.Save
    wbTargetB.Close SaveChanges:=False
    
    ' 释放对象内存
    Set wbSourceA = Nothing
    Set wbTargetB = Nothing
End Sub

额外注意事项 #

• 如果你的命名区域是工作表级的，只需要把wbSourceA.Range(rangeName)修改为wbSourceA.Worksheets("你存放命名区域的工作表名").Range(rangeName)即可
• 运行代码前请确保你对对应SharePoint路径有编辑权限，避免保存时抛出权限错误
• 如果SharePoint文件已被其他人锁定编辑，代码会抛出打开失败错误，你可以根据需要自行添加错误处理逻辑捕获该场景

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