Add running number and subtotal for each section in an excel worksheet-CodePudding

I have several worksheets that need to be combined into a worksheet with the additional running number and CountA on top for each separate section, and before the start of each new section I want to input the title.

I have recorded the modules for combining the worksheet as shown below.

Sub DUTY_FREE()

 Macro3 Macro

Application.ScreenUpdating = False
'
    Dim Lrow As Long
    
    'Lrow = Sheets("DUTY FREE").Range("A1").CurrentRegion.Rows.Count (range)
    Lrow = Sheets("DUTY FREE").UsedRange.Rows.Count
    
  
    Sheets("DUTY FREE").Range("A1:AU" & Lrow).Copy
    
    Sheets("Combine").Select
    Sheets("Combine").Range("A1").Select
    
    Sheets("Combine").Paste
    
    
    Dim LrowTLS As Long
    
    Sheets("Combine").Select
    
    Dim lastrow As Long
    Dim LastRow2 As Long
    Dim rngTLS As Range
     
     lastrow = Sheets("Combine").Cells(Rows.Count, 1).End(xlUp).Row
      LastRow2 = Sheets("Combine").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row

Set rngTLS = Cells((LastRow2   2), 1)

   LrowTLS = Sheets("TLS").UsedRange.Rows.Count

    Sheets("TLS").Range("A1:AU" & LrowTLS).Copy

    
    rngTLS.Select
    ActiveSheet.Paste
 End Sub

Sub Anntana()
    
    Dim LrowAnntana As Long
    
    Sheets("Combine").Select
    
    
    Dim LastRowAnntana1 As Long
    Dim LastRowAnntana2 As Long
    Dim rngAnntana As Range
     
    LastRowAnntana1 = Sheets("Combine").Cells(Rows.Count, 1).End(xlUp).Row
    LastRowAnntana2 = Sheets("Combine").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row

Set rngAnntana = Cells((LastRowAnntana2   2), 1)

   LrowAnntana = Sheets("Anntana").UsedRange.Rows.Count

    Sheets("Anntana").Range("A1:AU" & LrowAnntana   1).Copy

    
    rngAnntana.Select
    ActiveSheet.Paste
End Sub

This is what I get from the code, I can do a combination of multiple criteria as expect, however I still cannot figure it out how to add some formula on top of each section.

Here is What I expect to get additional updated,

CodePudding user response：

You can add running number for each section by finding data from column "B" if there is no data the formula will return empty and start counting from 1 for the next part.

Sub addnumber ()

Dim lastrow As Long
Dim rngnumber As Range
Dim ws as worksheet
 
 lastrow = Sheets("Combine").Cells(Rows.Count, 3).End(xlUp).Row.Offset(1).Row

Set rngnumber = Cells((LastRow 2), 1)

Range("A2").FormulaR1C1 = _
    "=IF(RC[1]="""","""",IF(AND(ISFORMULA(R[-1]C[1]),R[-1]C=""""),1," & Chr(10) & "IF(AND(R[-1]C[1]<>"""",RC[1]=""""),""""")""

Range("A2").AutoFill Destination:=Range("A2:A" & lastrow)
Columns("A:A").Select

Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

End sub

For the count number on top of each part, I suggest adding more columns after you complete adding the running number but instead of finding text, you can look for number 1 which is the start number for each section, and you can find the right position of each title by offset function.