如何使此Excel宏保存为.xls(Excel 97-2003)格式,而不是.xlsx



这个宏非常接近我所需要的:如何将电子表格拆分为多个具有固定行数的电子表格?

它根据行数将较长的 Excel 文件拆分为较小的文件。

但是,我需要修改它以将文件保存为.xls(Excel 97-2003(格式。

我需要更改什么?

这是我现在正在使用的内容:

Sub Test()
  Dim wb As Workbook
  Dim ThisSheet As Worksheet
  Dim NumOfColumns As Integer
  Dim RangeToCopy As Range
  Dim RangeOfHeader As Range        'data (range) of header row
  Dim WorkbookCounter As Integer
  Dim RowsInFile                    'how many rows (incl. header) in new files?
  Application.ScreenUpdating = False
  'Initialize data
  Set ThisSheet = ThisWorkbook.ActiveSheet
  NumOfColumns = ThisSheet.UsedRange.Columns.Count
  WorkbookCounter = 1
  RowsInFile = 100                   'as your example, just 10 rows per file
  'Copy the data of the first row (header)
  Set RangeOfHeader = ThisSheet.Range(ThisSheet.Cells(1, 1), ThisSheet.Cells(1, NumOfColumns))
  For p = 2 To ThisSheet.UsedRange.Rows.Count Step RowsInFile - 1
    Set wb = Workbooks.Add
    'Paste the header row in new file
    RangeOfHeader.Copy wb.Sheets(1).Range("A1")
    'Paste the chunk of rows for this file
    Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p + RowsInFile - 2, NumOfColumns))
    RangeToCopy.Copy wb.Sheets(1).Range("A2")
    'Save the new workbook, and close it
    wb.SaveAs ThisWorkbook.Path & "splitoutput" & WorkbookCounter
    wb.Close
    'Increment file counter
    WorkbookCounter = WorkbookCounter + 1
  Next p
  Application.ScreenUpdating = True
  Set wb = Nothing
End Sub

Workbook.SaveAsxlFileFormat 枚举文档在此处很有帮助。

改变

wb.SaveAs ThisWorkbook.Path & "splitoutput" & WorkbookCounter

wb.SaveAs FileName:=ThisWorkbook.Path & "splitoutput" & WorkbookCounter, FileFormat:=xlWorkbookNormal

最新更新