スプレッドシートを複数のスプレッドシートに分割する方法

Question

433行（先頭にヘッダー行を加えたもの）のExcel（2007）スプレッドシートがあります。これを分割して、それぞれ10行と残りの3行を含む43個のスプレッドシートファイルに分割する必要があります。ヘッダー行を各スプレッドシートの上部に配置することが望ましいでしょう。どうすればこれを達成できますか？参考までに、このような「上位レベル」のExcel機能については、ちょっとした初心者です。

ありがとうございます！

Answer 1

マクロは、最初の行のヘッダー行を含めて、選択した範囲内のすべての行を分割するだけです（最初のファイルに1回だけ表示されます）。私はあなたが求めているもののためにマクロを修正しました。それは簡単です、私はそれが何かを見るために書いたコメントを見直してください。

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

私はMacユーザーに@Ferガルシアによってコードを更新;）、ストレートExcelでの方法

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