VBA拆分Excel文件时如何继承原文件的列格式？

你的代码当前仅复制了单元格的值，未同步格式。要让拆分后的文件继承原表的列格式（包括单元格格式、列宽等），可以通过复制粘贴带格式的内容实现，以下是修改后的完整代码：

Sub dividerows()

Dim ACS As Range, Z As Long, New_WB As Workbook, _
Total_Columns As Long, Start_Row As Long, Stop_Row As Long, Copied_Range As Range

Dim AC As String: AC = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)

Set ACS = ActiveSheet.UsedRange

With ACS
    Total_Columns = .Columns.Count
End With

Start_Row = 2

Do While Stop_Row <= ACS.Rows.Count
    
    Z = Z + 1
    
    If Z > 1 Then Start_Row = Stop_Row + 1
    
    Stop_Row = Start_Row + 499
    
    With ACS.Rows
        If Stop_Row > .Count Then Stop_Row = .Count
    End With
    
    With ACS
        Set Copied_Range = .Range(.Cells(Start_Row, 1), .Cells(Stop_Row, Total_Columns))
    End With
    
    Set New_WB = Workbooks.Add
    
    With New_WB
        With .Worksheets(1)
            ' 复制原表表头（含格式）到新表第一行
            ACS.Rows(1).Copy
            .Rows(1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
            .Rows(1).PasteSpecial Paste:=xlPasteColumnWidths
            
            ' 复制数据区域（含格式）到新表第二行开始
            Copied_Range.Copy
            .Cells(2, 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
            .Cells(2, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            
            ' 清除剪贴板，避免后续操作干扰
            Application.CutCopyMode = False
        End With
        
       .SaveAs ACS.Parent.Parent.Path & Application.PathSeparator & AC & "_Part" & Z & ".xlsx", FileFormat:=51
       .Close
       
    End With
    
    If Stop_Row = ACS.Rows.Count Then Exit Do
    
Loop

End Sub

关键修改说明 #

• 移除原代码仅赋值的逻辑，改用Copy+PasteSpecial组合同步格式：
  • xlPasteAllUsingSourceTheme：复制原单元格的字体、填充、边框、日期/文本格式等全部格式信息
  • xlPasteColumnWidths：同步原表的列宽，保证列显示效果完全一致
  • xlPasteValuesAndNumberFormats：确保数据值和数字格式（如日期格式）准确同步，避免主题粘贴可能出现的偏差
• 增加Application.CutCopyMode = False清除剪贴板，防止后续操作受残留复制内容影响

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