पंक्तियों की सेट संख्या के साथ स्प्रेडशीट को एकाधिक स्प्रेडशीट में कैसे विभाजित करें?

Question

मेरे पास 433 पंक्तियों के साथ एक एक्सेल (2007) स्प्रेडशीट है (साथ ही शीर्ष पर शीर्षलेख पंक्ति)। मुझे इसे 43 व्यक्तिगत स्प्रेडशीट फ़ाइलों में विभाजित करने की आवश्यकता है जिसमें प्रत्येक पंक्ति 10 पंक्तियां हैं और शेष 3 पंक्तियां हैं। प्रत्येक स्प्रेडशीट के शीर्ष पर शीर्षलेख पंक्ति होना भी बेहतर होगा। मैं यह कैसे हासिल कर सकता हूं? एफवाईआई, जब मैं इस तरह के "उच्च स्तर" एक्सेल कार्यों की बात करता हूं, तो मैं एक नौसिखिया हूं।

धन्यवाद!

Answer 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

मैं मैक उपयोगकर्ताओं के लिए @Fer गार्सिया द्वारा कोड अद्यतन;), केवल फ़ाइल को सहेजने विधि

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