如何通过VBA将指定工作表复制到目标工作簿，保留格式且仅粘贴值

以下是完全适配你需求的VBA代码，直接在源工作簿中执行即可：

Sub CopySheetsToReport()
    Dim srcWB As Workbook
    Dim destWB As Workbook
    Dim wsNames As Variant
    Dim wsName As Variant
    Dim destWS As Worksheet
    Dim targetPath As String
    Dim targetFile As String
    
    ' 定义源工作簿和目标文件路径
    Set srcWB = ThisWorkbook
    targetPath = "C:\Users\Username\Desktop\Tool-Print\"
    targetFile = targetPath & "Report.xlsx"
    
    ' 检查目标文件夹是否存在，不存在则创建
    If Dir(targetPath, vbDirectory) = "" Then
        MkDir targetPath
    End If
    
    ' 打开或创建目标工作簿
    On Error Resume Next
    Set destWB = Workbooks.Open(targetFile)
    On Error GoTo 0
    If destWB Is Nothing Then
        Set destWB = Workbooks.Add
        destWB.SaveAs Filename:=targetFile, FileFormat:=xlOpenXMLWorkbook
    End If
    
    ' 指定需要复制的工作表名称
    wsNames = Array("Dashboard", "Similar jobs", "Comparable jobs", "Salary distributions")
    
    ' 遍历每个指定工作表进行复制和处理
    For Each wsName In wsNames
        ' 复制工作表到目标工作簿末尾
        srcWB.Worksheets(wsName).Copy After:=destWB.Sheets(destWB.Sheets.Count)
        Set destWS = destWB.Sheets(destWB.Sheets.Count)
        
        ' 保留格式并将公式转为值
        destWS.UsedRange.Copy
        destWS.UsedRange.PasteSpecial Paste:=xlPasteValuesAndNumberFormats ' 保留值和数字格式
        destWS.UsedRange.PasteSpecial Paste:=xlPasteFormats ' 保留单元格格式（字体、颜色等）
        Application.CutCopyMode = False ' 清除复制缓存
        
        ' 处理Dashboard工作表的文本框静态化
        If wsName = "Dashboard" Then
            Dim shp As Shape
            For Each shp In destWS.Shapes
                ' 判断是否为文本框（兼容表单控件和ActiveX控件）
                If shp.Type = msoTextBox Or (shp.OLEFormat Is Not Nothing And shp.OLEFormat.Object.Name Like "TextBox*") Then
                    If shp.Type = msoTextBox Then
                        shp.TextFrame2.TextRange.Text = shp.TextFrame2.TextRange.Text
                    Else
                        shp.OLEFormat.Object.Value = shp.OLEFormat.Object.Value
                    End If
                End If
            Next shp
        End If
    Next wsName
    
    ' 保存并关闭目标工作簿
    destWB.Save
    destWB.Close
    
    MsgBox "工作表复制处理完成！", vbInformation
End Sub

代码关键细节说明 #

• 目标工作簿处理：自动检查目标路径，不存在则创建；Report.xlsx已存在则直接打开，不存在则新建保存，无需手动操作。
• 批量复制指定工作表：通过数组定义4个目标工作表，循环处理避免重复代码，不会生成独立工作簿。
• 公式转值+格式保留：分两次使用PasteSpecial，先粘贴值和数字格式，再粘贴单元格格式，确保原样式完整保留，同时清除所有公式。
• Dashboard文本框静态化：遍历工作表内所有形状，识别文本框控件，将当前显示内容设为静态值，切断与源工作簿Parameters表的关联。

使用注意事项 #

1. 替换代码中的C:\Users\Username\Desktop\Tool-Print\为你的实际目标路径（注意路径末尾的斜杠不能省略）。
2. 执行前确认源工作簿的4个指定工作表存在，避免触发报错。
3. 若目标工作簿Report.xlsx已打开，代码会直接使用该工作簿进行操作。

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