如何为Sharepoint编写VBA实现多Excel工作簿指定工作表汇总更新？

一、VBA宏实现数据追加与自动更新 #

录制宏失败是因为它默认处理本地文件，无法适配Sharepoint的HTTP路径和权限验证逻辑，手动编写宏可以解决这个问题。以下是可直接使用的代码，能保留格式、公式并自动追加数据：

Sub MergeSharepointSheets()
    Dim masterWB As Workbook
    Dim masterWS As Worksheet
    Dim sourceWBs As Variant
    Dim sourceSheetNames As Variant
    Dim sourceWB As Workbook
    Dim sourceWS As Worksheet
    Dim lastRowMaster As Long
    Dim lastRowSource As Long
    Dim i As Integer, j As Integer
    
    ' 指定主工作簿和目标工作表
    Set masterWB = ThisWorkbook
    Set masterWS = masterWB.Worksheets("master data")
    
    ' 替换为你的Sharepoint源工作簿实际路径（注意空格转成%20）
    sourceWBs = Array( _
        "https://yoursharepointsite/sites/xxx/Shared%20Documents/Source1.xlsx", _
        "https://yoursharepointsite/sites/xxx/Shared%20Documents/Source2.xlsx", _
        "https://yoursharepointsite/sites/xxx/Shared%20Documents/Source3.xlsx", _
        "https://yoursharepointsite/sites/xxx/Shared%20Documents/Source4.xlsx", _
        "https://yoursharepointsite/sites/xxx/Shared%20Documents/Source5.xlsx" _
    )
    
    ' 要合并的目标工作表名称
    sourceSheetNames = Array("holidays", "sickness", "request", "overtime", "jobs")
    
    ' 关闭屏幕更新提升运行效率
    Application.ScreenUpdating = False
    
    ' 遍历所有源工作簿
    For i = LBound(sourceWBs) To UBound(sourceWBs)
        ' 处理权限不足或路径错误的情况
        On Error Resume Next
        Set sourceWB = Workbooks.Open(sourceWBs(i), ReadOnly:=True)
        On Error GoTo 0
        
        If Not sourceWB Is Nothing Then
            ' 遍历每个要合并的工作表
            For j = LBound(sourceSheetNames) To UBound(sourceSheetNames)
                On Error Resume Next
                Set sourceWS = sourceWB.Worksheets(sourceSheetNames(j))
                On Error GoTo 0
                
                If Not sourceWS Is Nothing Then
                    ' 获取主表最后一行位置
                    lastRowMaster = masterWS.Cells(masterWS.Rows.Count, "A").End(xlUp).Row
                    ' 获取源表数据最后一行位置（从第2行开始复制，跳过表头）
                    lastRowSource = sourceWS.Cells(sourceWS.Rows.Count, "A").End(xlUp).Row
                    
                    ' 复制所有内容（含格式、公式）并追加到主表
                    sourceWS.Range("A2:" & sourceWS.Cells(lastRowSource, sourceWS.Columns.Count).Address).Copy
                    masterWS.Cells(lastRowMaster + 1, "A").PasteSpecial Paste:=xlPasteAll
                    Application.CutCopyMode = False
                End If
            Next j
            sourceWB.Close SaveChanges:=False
            Set sourceWB = Nothing
        Else
            MsgBox "无法访问工作簿：" & sourceWBs(i) & "，请检查权限或路径"
        End If
    Next i
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
    MsgBox "数据合并完成！"
End Sub

实现自动更新 #

把宏绑定到主工作簿的打开事件，打开文件时自动执行合并：

1. 按Alt+F11打开VBA编辑器
2. 双击左侧的ThisWorkbook模块
3. 粘贴以下代码：

Private Sub Workbook_Open()
    MergeSharepointSheets
End Sub

注意事项 #

• 替换代码中的Sharepoint路径为实际路径，可直接从浏览器复制后替换空格为%20
• 确保主工作簿存在“master data”工作表，且表头与源表一致
• 运行宏的账号需拥有所有源工作簿的读取权限

二、Sharepoint直接链接指定工作表到主工作簿 #

无需VBA，用Excel的Power Query功能可直接从Sharepoint拉取数据并实现自动更新，步骤如下：

1. 打开主工作簿的“master data”工作表
2. 点击「数据」选项卡 → 「获取数据」→ 「从文件」→ 「从Sharepoint文件夹」
3. 输入Sharepoint站点URL（如https://yoursharepointsite/sites/xxx），点击确定
4. 在导航器中选择源工作簿所在文件夹，点击「转换数据」进入Power Query编辑器
5. 在编辑器中：
   • 添加「筛选列」，只保留你的5个目标工作簿
   • 添加「自定义列」，输入公式Excel.Workbook([Content])，展开该列并选择「工作表名称」和「数据」
   • 筛选「工作表名称」列，仅保留holidays、sickness、request、overtime、jobs
   • 展开「数据」列，确认表头匹配后点击「关闭并上载」
6. 自动更新：右键数据区域选择「刷新」，或在「数据」→「连接」→「属性」中勾选「打开文件时刷新数据」

这种方法的优势：权限由Sharepoint直接管理，无需维护VBA代码，数据结构自动同步。

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