VBA to dynamically select EACH block/range of cells on a worksheet, then copy/paste?

[ajjava]

Holy moly!! I've never used GoTo> Special > Constant....as you predicted, that DID select all the necessary ranges!!

Two other things, since my last post:
►I'm attaching the output file here, so it will be easier to see what we're dealing with
►I DID finally cobble together some code that works - HOWEVER, because of what I suspect is a "race condition" (as in "running", not "country you're from"...lol), it will periodically fail at the "Range("A16").PasteSpecial " line. I'm not sure what to do to stop that.

Here is the code (but please don't let that deter you from improving upon what I've come up with):

Sub FindAll()


'PURPOSE: Find all cells containing a specified value




Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range


'What value do you want to find (must be in string form)?
  fnd = "Total"  'Enter what you're looking for here


Set myRange = ActiveSheet.UsedRange
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:=fnd, after:=LastCell, LookIn:=xlValues, lookat:=xlWhole) 'xlWhole will allow search for JUST the word "Total" and NOT something like "Total Incurred"
'Test to see if anything was found
  If Not FoundCell Is Nothing Then
    FirstFound = FoundCell.Address
  Else
    GoTo NothingFound
  End If


Set rng = FoundCell
'FoundCell.Select


'Loop until cycled through all unique finds
  Do Until FoundCell Is Nothing
    
    FoundCell.currentregion.CopyPicture
    DoEvents
    Range("A16").PasteSpecial
    DoEvents
    
    'Find next cell with fnd value
      Set FoundCell = myRange.FindNext(after:=FoundCell)
        DoEvents
    'Add found cell to rng range variable
      'Set rng = Union(rng, FoundCell)
    
    'Test to see if cycled through to first found cell
      If FoundCell.Address = FirstFound Then Exit Do
      
  Loop


'Select Cells Containing Find Value
  'rng.Select
MsgBox "Macro is done"
  
Exit Sub


'Error Handler
NothingFound:
  MsgBox "No values were found in this worksheet"


End Sub