Multiple tabs set row count based on sheet 1

Solved/Closed
oli - Apr 16, 2010 at 05:26 AM
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
- Apr 16, 2010 at 11:45 AM
Hi

Sheet 1 contains > 1000 rows of populated data. I need to create x number of tabs each containg the next 25 rows from the sheet1 data. ie 1000 rows of sheet1 data needs to be restructured into 40 tabs each containg the next 25 rows of data from sheet1.

each 25 rows need to be totalled. (column c,d and e)
each tab has a standard header (company address spanning 6 rows).

Please provide The VBA code to accomplish this task.

thanx

oli

6 replies

rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
769
Apr 16, 2010 at 11:45 AM
Sub createTabs()
Dim sDataSheet As String
Dim lMaxRows As Long
Dim lRowBeanCounter As Long
Dim iLoop As Integer
Dim sNewSheet As String
Dim iDataCol As Integer
Dim sDataCol As String
Dim iCopyRows As Integer
Dim myRange As Range
Dim lNewMaxRows As Long

    sDataSheet = "Sheet1"
    iCopyRows = 25
    
    Sheets(sDataSheet).Select

    lMaxRows = Cells(Rows.Count, "A").End(xlUp).Row
    iDataCol = Cells(1, Columns.Count).End(xlToLeft).Column
    sDataCol = Cells(1, Columns.Count).End(xlToLeft).Address
    sDataCol = Mid(sDataCol, 1, InStr(2, sDataCol, "$") - 1)
    sDataCol = Mid(sDataCol, 2)
    
    For lRowBeanCounter = 2 To lMaxRows Step iCopyRows
    
        iLoop = iLoop + 1
        sNewSheet = "Tab " & Right("000" & iLoop, 3)
        
        On Error Resume Next
        Application.DisplayAlerts = False
        Sheets(sNewSheet).Delete
        Application.DisplayAlerts = True
        On Error GoTo 0
        
        Sheets.Add
        ActiveSheet.Name = sNewSheet
        
        Sheets(sDataSheet).Select
        
        With Sheets(sNewSheet)
        
        .Range("A1:" & sDataCol & "1") = Range("A1:" & sDataCol & "1").Value
        
        .Range("A2:" & sDataCol & iCopyRows + 1) = _
                        Range(Cells(lRowBeanCounter, 1), Cells(lRowBeanCounter + iCopyRows - 1, iDataCol)).Value
        
        lNewMaxRows = .Cells(Rows.Count, "A").End(xlUp).Row
        
        .Range("C" & lNewMaxRows + 1 & ":E" & lNewMaxRows + 1).FormulaR1C1 = "=SUM(R2C:R" & lNewMaxRows & "C)"
    
        .Rows("1:6").Insert
        .Range("A1") = "abc trading"
        .Range("A2") = "25 qwerty road"
        .Range("A3") = "asdf town"
        .Range("A4") = "postal code: 1234"
        .Range("A5") = "tel: 123456789"
        .Range("A6") = "fax: 123456789"
    
    End With
        
    Next lRowBeanCounter
    
End Sub
1
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
769
Apr 16, 2010 at 05:51 AM
What are you exactly looking for ?
0
Hi, soz i need VBA code to accomplish the task as set out. Please indicate if i need to expand the problem criteria.
0
rizvisa1
Posts
4479
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
769
Apr 16, 2010 at 06:24 AM
Yes please do expand more. Could you please upload a sample file on some shared site like https://authentification.site and post back here the link to allow better understanding of how it is now and how you foresee.
0

Didn't find the answer you are looking for?

Ask a question
please, i would realy appreciate help with this problem.
0