简体   繁体   中英

Copying subtotal to a new worksheet in Excel using VBA

I am filtering a large data set on the first sheet in my workbook and then I am creating a separate worksheet in the workbook for each unique name in the first column of the main data set.

After I filter the main data set for a given name, I am attempting to subtotal a particular filtered column (let's say column C), for example:

Sub CreateSheets()

    Dim wsCurrent As Worksheet
    Dim wsNew As Worksheet
    Dim iLeft As Integer
    Dim length As Long

    Set wsCurrent = ActiveSheet
    Application.ScreenUpdating = False

    'Copy list of all players and remove duplicates
    Range("A2", Range("A2").End(xlDown)).Copy Range("AY1")
    Range("AY1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes

    'Iterator
    iLeft = Range("AY1").CurrentRegion.Rows.Count - 1

    'For each player
    Do While iLeft > 13
        Set wsNew = Worksheets.Add
        With wsCurrent.Range("A2").CurrentRegion
            'Player name from copied list
            .AutoFilter Field:=1, Criteria1:=wsCurrent.Range("AY1").Offset(iLeft).Value

            'Hits
            .AutoFilter Field:=3, Criteria1:="1"
            length = .Range("C" & Rows.Count).End(xlUp).Row
            wsNew.Range("A1") = "=SUBTOTAL(9," & wsCurrent.Name & "!C2:C" & length & ")"

            'Turn off filters
            '.AutoFilter
        End With
        'Name player sheet and move onto next
        wsNew.Name = wsCurrent.Range("AY1").Offset(iLeft).Value
        iLeft = iLeft - 1
    Loop

    'Clear player names in copied region
    wsCurrent.Range("AY1").CurrentRegion.Clear
    Application.ScreenUpdating = True

End Sub

The main issue here is that the subtotal function call no longer find the referenced cell on the main sheet. Any help is much appreciated.

EDIT:

The following now provides the correct subtotal.

length = .Range("C" & Rows.Count).End(xlUp).Row
wsNew.Range("A1") = "=SUBTOTAL(9," & wsCurrent.Name & "!C2:C" & length & ")"
wsNew.Range("A1").Value = wsNew.Range("A1").Value

The last line ensures that when the filter is removed, the original sum of the visible cells remains (instead of then taking the sum of the visible cells with the filter now removed).

Have you tried including the original sheet name as a reference in the Subtotal formula?

wsNew.Range("A1") = "=SUBTOTAL(9," & wsCurrent.Name & "!C2:C" & length & ")"

I replaced 9,C2:C with 9, " & wsCurrent.Name & "!C2:C which should reference it properly.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM