如何将电子表格分割成多个设置了行数的电子表格？

我有一个Excel（2007）电子表格，有433行（加上顶部的标题行）。 我需要将其分成43个单独的电子表格文件，每行10行，其余3行中的一行。 最好在每个电子表格的顶部都有标题行。 我怎样才能做到这一点？ 仅供参考，当涉及到“更高级别”的Excelfunction时，我是一个新手。

谢谢！

Answer 1

你的macros只是分割了选定范围内的所有行，包括第一行的标题行（所以它只会出现在第一个文件的一次）。 我修改了你所要求的macros。 这很容易，请查看我写的意见，看看它做了什么。

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 = 10 '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 & "\test" & WorkbookCounter wb.Close 'Increment file counter WorkbookCounter = WorkbookCounter + 1 Next p Application.ScreenUpdating = True Set wb = Nothing End Sub 

希望这可以帮助。

Answer 2

我通过@Fer Garcia更新了Mac用户的代码;），仅在文件保存方法中进行更改

 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 = 150 '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 "Test" & WorkbookCounter & ".xls", FileFormat:=57 wb.Close 'Increment file counter WorkbookCounter = WorkbookCounter + 1 Next p Application.ScreenUpdating = True Set wb = Nothing End Sub