用于复制工作簿并在工作表之间保留相对单元格引用的VBA

Sub CopyWorkbookWithRelativeCellReferences()
    Dim sourceWorkbook As Workbook
    Dim newWorkbook As Workbook
    Dim sourceWorksheet As Worksheet
    Dim newWorksheet As Worksheet
    
    ' 设置源工作簿和目标工作簿
    Set sourceWorkbook = ThisWorkbook
    Set newWorkbook = Workbooks.Add
    
    ' 复制每个工作表
    For Each sourceWorksheet In sourceWorkbook.Worksheets
        ' 在目标工作簿中创建新的工作表
        Set newWorksheet = newWorkbook.Worksheets.Add
        
        ' 复制源工作表的内容和格式
        sourceWorksheet.Cells.Copy newWorksheet.Cells
        
        ' 调整相对单元格引用
        newWorksheet.Cells.Replace What:="=[", Replacement:="='[" & sourceWorkbook.Name & "]"
    Next sourceWorksheet
    
    ' 保存目标工作簿
    newWorkbook.SaveAs "目标工作簿的文件路径和名称.xlsx"
    
    ' 关闭目标工作簿
    newWorkbook.Close
    
    ' 释放对象变量
    Set newWorksheet = Nothing
    Set newWorkbook = Nothing
    Set sourceWorksheet = Nothing
    Set sourceWorkbook = Nothing
End Sub