How to loop through several regions of a worksheet? - excel

Question

I'm looking for some VBA that will allow me to loop through several different REGIONS on a worksheet. Not individual cells, necessarily, but to jump from "currentregion" to the next "currentregion". And once the region is located, it should be selected and copied.
I've tried setting a StartCell (via Cells.Find(What:="*") and then using that cell to select the corresponding 'currentregion'. The issue is how to move to the next 'currentregion', until all 'currentregions' on the worksheet have been copied/pasted.
My results are inconsistent so far, where sometimes all the necessary regions are copied/pasted, but other times some of the regions are ignored (same exact worksheet, same exact data).
Set StartCell = Cells.Find(What:="*", _
After:=Cells(Rows.Count, Columns.Count), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)Do
'Select Range and copy it
If StartCell <> "" Then
StartCell.currentregion.CopyPicture
'Select a cell to paste the picture in
Range("A16").PasteSpecial
'Move to next range to be copied
Set StartCell = StartCell.End(xlToRight).End(xlToRight)
StartCell.Select
End If
Loop Until StartCell = ""

Answer 1

Something like that should work
Option Explicit
Public Sub ProcessEachRegion()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") 'define your sheet
Dim StartCell As Range
Set StartCell = ws.Range("A1") 'define start cell
Do Until StartCell.Column = ws.Columns.Count 'loop until end of columns
With StartCell.CurrentRegion
'do all your copy stuff here!
'.Copy
'Destination.Paste
Set StartCell = .Resize(1, 1).Offset(ColumnOffset:=.Columns.Count - 1).End(xlToRight)
End With
Loop
End Sub
It looks for the next region right to the previous one (regions 1 to 5 in the example below).

Answer 2

The main sub (I named it tgr) will call a function named GetAllPopulatedCells which defines a range for all populated cells in a worksheet. The .Areas property will let your loop through each region. It will then copy each Area/Region as a picture (still not sure why you want this) and put it in the destination cell, and then adjust the destination cell as needed so that all of the pasted images are stacked on top of each other.
Sub tgr()
Dim ws As Worksheet
Dim rAllRegions As Range
Dim rRegion As Range
Dim rDest As Range
Set ws = ActiveWorkbook.ActiveSheet
Set rAllRegions = GetAllPopulatedCells(ws)
Set rDest = ws.Range("A16")
If rAllRegions Is Nothing Then
MsgBox "No populated cells found in '" & ws.Name & "'. Exiting Macro.", , "Error"
Exit Sub
End If
For Each rRegion In rAllRegions.Areas
rRegion.CopyPicture
rDest.PasteSpecial
Set rDest = rDest.Offset(rRegion.Rows.Count)
Next rRegion
End Sub
Public Function GetAllPopulatedCells(Optional ByRef arg_ws As Worksheet) As Range
Dim ws As Worksheet
Dim rConstants As Range
Dim rFormulas As Range
If arg_ws Is Nothing Then Set ws = ActiveWorkbook.ActiveSheet Else Set ws = arg_ws
On Error Resume Next
Set rConstants = ws.Cells.SpecialCells(xlCellTypeConstants)
Set rFormulas = ws.Cells.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
Select Case Abs(rConstants Is Nothing) + 2 * Abs(rFormulas Is Nothing)
Case 0: Set GetAllPopulatedCells = Union(rConstants, rFormulas)
Case 1: Set GetAllPopulatedCells = rFormulas
Case 2: Set GetAllPopulatedCells = rConstants
Case 3: Set GetAllPopulatedCells = Nothing
End Select
Set ws = Nothing
Set rConstants = Nothing
Set rFormulas = Nothing
End Function