如何将电子表格拆分成多个具有设定行数的电子表格？ [英] How to split spreadsheet into multiple spreadsheets with set number of rows?

问题描述

我有一个带有433行的Excel（2007）电子表格（加上顶部的标题行）。我需要将它分成43个单独的电子表格文件，每行10行，其余3行。也可以在每个电子表格的顶部设置标题行。我该如何做到这一点？ FYI，对于这样的更高级的Excel函数，我有点新手。

谢谢！

解决方案

您的宏只是拆分所选范围内的所有行，包括第一行中的标题行（因此在第一个文件中将只显示一次）。我修改了你所要求的宏;很容易，请查看我写的评论，看看它的作用。

  Sub Test（）
 Dim wb As Workbook 
 Dim ThisSheet As工作表
 Dim NumOfColumns As Integer 
 Dim RangeToCopy As Range 
 Dim RangeOfHeader As Range'header row的数据（范围）
 Dim WorkbookCounter As Integer 
 Dim RowsInFile'新文件中的行（包括头文件）？ 
 
 Application.ScreenUpdating = False 
 
'初始化数据
设置ThisSheet = ThisWorkbook.ActiveSheet 
 NumOfColumns = ThisSheet.UsedRange.Columns.Count 
 WorkbookCounter = 1 
 RowsInFile = 10'作为示例，每个文件只有10行
 
'复制第一行（标题）
的数据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 
 
'将标题行粘贴到新文件中
 RangeOfHeader.Copy wb.Sheets（1）.Range（A1）
 
'粘贴该文件的块块
设置RangeToCopy = ThisSheet.Range（ThisSheet.Cells（p，1），ThisSheet.Cells（p + RowsInFile  -  2，NumOfColumns））
 RangeToCopy.Copy wb.Sheets 1）.Range（A2）
 
'保存新的工作簿，并关闭它
 wb.SaveAs ThisWorkbook.Path& \test& WorkbookCounter 
 wb.Close 
 
'增量文件计数器
 WorkbookCounter = WorkbookCounter + 1 
下一页p 
 
 Application.ScreenUpdating = True 
设置wb =没有
结束子
  

希望这有帮助。

I have an Excel (2007) spreadsheet with 433 rows (plus the header row at the top). I need to split this up into 43 individual spreadsheet files with 10 rows each and one with the remaining 3 rows. It would be preferable to have the header row at the top of each spreadsheet as well. How can I accomplish this? FYI, I am a bit of a newbie when it comes to "higher level" Excel functions like this.

Thanks!

解决方案

Your macro is just splitting all the rows in the selected range, including the header row in the first row (so it will appear just one time, in the first file). I modified the macro for what you're asking; it's easy, review the comments I wrote to see what it does.

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

Hope this helps.

这篇关于如何将电子表格拆分成多个具有设定行数的电子表格？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！