Multiple tabs set row count based on sheet 1 [Solved/Closed]

Report
-
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
-
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

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
762
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
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2942 users have said thank you to us this month

Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
762
What are you exactly looking for ?
Hi, soz i need VBA code to accomplish the task as set out. Please indicate if i need to expand the problem criteria.
Posts
4476
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
August 2, 2020
762
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.
please, i would realy appreciate help with this problem.

Subscribe To Our Newsletter!

The Best of CCM in Your Inbox

Subscribe To Our Newsletter!