The reason I am doing this is so I can then copy all the data from the total rows at one time and paste into another workbook. If I try to do it on this grouped rows, I wind up getting all of the data in
the group and all I want is the Total's rows. Unless I did one row at a time of course.
Right-click on the sheet tab
Choose "View Code"
Within the menu click Insert \ Module
Paste in the code below
Close the VBA editor
Press Alt-F8
Choose a macro
Click Run
Notes:
a) I made 3 main routines as example, choose the one you like. They work the way they sound.
b) It doesn't matter for my code if the rows are grouped or not.
c) A comment to your macro:
Please never use SELECT, SELECTION, ACTIVECELL, it is slow and error prone. Always refer to the objects directly.
Andreas.
Option Explicit
Sub CopyBelowTheData()
Dim All As Range, Dest As Range
'Find all Total rows
Set All = FindAll(Range("A:A"), "Total", LookAt:=xlPart)
'Find an empty cell below the data
Set Dest = Range("A" & Rows.Count).End(xlUp).Offset(2)
'Copy the rows
All.EntireRow.Copy
'Paste as Value
Dest.PasteSpecial xlPasteValues
'Cancel the copy
Application.CutCopyMode = False
End Sub
Sub CopyToNewSheet()
Dim All As Range, Dest As Range
Dim Ws As Worksheet
'Find all Total rows
Set All = FindAll(Range("A:A"), "Total", LookAt:=xlPart)
'Create a new sheet
Set Ws = Worksheets.Add(After:=Sheets(Sheets.Count))
'The destination is A1
Set Dest = Ws.Range("A1")
'Copy the rows
All.EntireRow.Copy
'Paste as Value
Dest.PasteSpecial xlPasteValues
'Cancel the copy
Application.CutCopyMode = False
End Sub
Sub CopyToNewFile()
Dim All As Range, Dest As Range
Dim Wb As Workbook
'Find all Total rows
Set All = FindAll(Range("A:A"), "Total", LookAt:=xlPart)
'Create a new file with one sheet
Set Wb = Workbooks.Add(xlWBATWorksheet)
'The destination is A1
Set Dest = Wb.Worksheets(1).Range("A1")
'Copy the rows
All.EntireRow.Copy
'Paste as Value
Dest.PasteSpecial xlPasteValues
'Cancel the copy
Application.CutCopyMode = False
End Sub
Private Function FindAll(ByVal Where As Range, ByVal What, _
Optional ByVal After As Variant, _
Optional ByVal LookIn As XlFindLookIn = xlValues, _
Optional ByVal LookAt As XlLookAt = xlWhole, _
Optional ByVal SearchOrder As XlSearchOrder = xlByRows, _
Optional ByVal SearchDirection As XlSearchDirection = xlNext, _
Optional ByVal MatchCase As Boolean = False, _
Optional ByVal SearchFormat As Boolean = False) As Range
'Find all occurrences of What in Where (Windows version)
Dim FirstAddress As String
Dim C As Range
'From FastUnion:
Dim Stack As New Collection
Dim Temp() As Range, Item
Dim i As Long, j As Long
If Where Is Nothing Then Exit Function
If SearchDirection = xlNext And IsMissing(After) Then
'Set After to the last cell in Where to return the first cell in Where in front if _
it match What
Set C = Where.Areas(Where.Areas.Count)
'BUG in XL2010: Cells.Count produces a RTE 6 if C is the whole sheet
'Set After = C.Cells(C.Cells.Count)
Set After = C.Cells(C.Rows.Count * CDec(C.Columns.Count))
End If
Set C = Where.Find(What, After, LookIn, LookAt, SearchOrder, _
SearchDirection, MatchCase, SearchFormat:=SearchFormat)
If C Is Nothing Then Exit Function
FirstAddress = C.Address
Do
Stack.Add C
If SearchFormat Then
'If you call this function from an UDF and _
you find only the first cell use this instead
Set C = Where.Find(What, C, LookIn, LookAt, SearchOrder, _
SearchDirection, MatchCase, SearchFormat:=SearchFormat)
Else
If SearchDirection = xlNext Then
Set C = Where.FindNext(C)
Else
Set C = Where.FindPrevious(C)
End If
End If
'Can happen if we have merged cells
If C Is Nothing Then Exit Do
Loop Until FirstAddress = C.Address
'FastUnion algorithm © Andreas Killer, 2011:
'Get all cells as fragments
ReDim Temp(0 To Stack.Count - 1)
i = 0
For Each Item In Stack
Set Temp(i) = Item
i = i + 1
Next
'Combine each fragment with the next one
j = 1
Do
For i = 0 To UBound(Temp) - j Step j * 2
Set Temp(i) = Union(Temp(i), Temp(i + j))
Next
j = j * 2
Loop Until j > UBound(Temp)
'At this point we have all cells in the first fragment
Set FindAll = Temp(0)
End Function
![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
