带指定工作表选择与存储路径的无公式多工作表导出需求

以下是适配需求的VBA代码，支持通过对话框选择目标工作表和SharePoint存储路径，自动完成无公式导出并移除原工作表：

Sub ArchiveSheetsToSharePoint()
    Dim selectedSheets As Variant
    Dim targetFolder As String
    Dim newWB As Workbook
    Dim ws As Worksheet
    Dim savePath As String
    
    ' 1. 弹出对话框让用户选择要归档的工作表（支持多选）
    On Error Resume Next
    selectedSheets = Application.InputBox( _
        Prompt:="请输入要归档的工作表名称（多个用逗号分隔，如：Sheet1,Sheet3）", _
        Title:="选择目标工作表", _
        Type:=2)
    On Error GoTo 0
    
    ' 如果用户取消输入，退出程序
    If selectedSheets = False Then Exit Sub
    
    ' 2. 弹出文件夹选择对话框，选择SharePoint目标文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "选择SharePoint归档文件夹"
        .AllowMultiSelect = False
        If .Show = -1 Then
            targetFolder = .SelectedItems(1) & "\"
        Else
            Exit Sub ' 用户取消选择，退出
        End With
    End With
    
    ' 3. 遍历选中的工作表，逐个处理
    For Each ws In ThisWorkbook.Worksheets
        ' 检查当前工作表是否在用户选择的列表中
        If InStr(1, selectedSheets, ws.Name, vbTextCompare) > 0 Then
            ' 新建空白工作簿
            Set newWB = Workbooks.Add(xlWBATWorksheet)
            
            ' 将当前工作表复制到新工作簿（值和格式，不带公式）
            ws.Cells.Copy
            newWB.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            newWB.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteFormats
            Application.CutCopyMode = False
            
            ' 重命名新工作表为原工作表名称
            newWB.Sheets(1).Name = ws.Name
            
            ' 构建保存路径（SharePoint路径支持直接写入）
            savePath = targetFolder & ws.Name & ".xlsx"
            
            ' 保存新工作簿并关闭
            Application.DisplayAlerts = False ' 覆盖已存在文件时不弹窗
            newWB.SaveAs Filename:=savePath, FileFormat:=xlOpenXMLWorkbook
            newWB.Close SaveChanges:=False
            Application.DisplayAlerts = True
            
            ' 从原工作簿移除当前工作表
            Application.DisplayAlerts = False ' 删除时不弹窗确认
            ws.Delete
            Application.DisplayAlerts = True
        End If
    Next ws
    
    MsgBox "归档完成！", vbInformation
End Sub

关键功能说明 #

• 多选工作表：通过输入框填写工作表名称（逗号分隔），新手也能轻松操作
• SharePoint路径选择：系统原生文件夹选择框，直接选SharePoint同步到本地的文件夹即可（或直接输入SharePoint在线路径，如https://xxx.sharepoint.com/sites/xxx/Documents/归档文件夹/）
• 无公式导出：使用xlPasteValuesAndNumberFormats和xlPasteFormats，只保留值和格式，剔除公式
• 自动移除原工作表：导出完成后自动删除原工作簿中的目标工作表，无需手动操作

使用步骤 #

1. 打开你的Excel工作簿，按Alt + F11打开VBA编辑器
2. 右键点击左侧的工作簿名称，选择「插入」→「模块」
3. 将上面的代码复制粘贴到模块中
4. 按F5运行代码，或回到Excel界面，通过「开发工具」→「宏」选择ArchiveSheetsToSharePoint执行

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