Come dividere il foglio di calcolo in più fogli di calcolo con il numero di righe impostato?

Question

Ho un foglio di calcolo Excel (2007) con 433 righe (più la riga di intestazione in alto). Devo dividerlo in 43 singoli fogli di calcolo con 10 righe ciascuno e una con le restanti 3 righe. Sarebbe preferibile avere la riga di intestazione nella parte superiore di ciascun foglio di calcolo. Come posso realizzare questo? Per tua informazione, sono un po 'un principiante quando si tratta di funzioni di Excel di "livello superiore" come questo.

Grazie!

Answer 1

La tua macro divide solo tutte le righe nell'intervallo selezionato, inclusa la riga di intestazione nella prima riga (quindi apparirà solo una volta, nel primo file). Ho modificato la macro per quello che stai chiedendo; è facile, rivedi i commenti che ho scritto per vedere cosa fa.

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 

Spero che questo aiuti.

Answer 2

ho aggiornato il codice @Fer Garcia per gli utenti Mac;), la modifica solo nel file di salvataggio metodo

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