Union Of Ranges For Copying
If you are serious about learning range programming, this book is a must!!
Some Excel applications require copying non-contiguous ranges of cells and then pasting them into a new worksheet. This example shows how to use the UNION command to combine ranges and then paste the superset of ranges created by the Union command.
Program Code
Option Explicit
Sub Copyrows()
Dim x As Long
Dim LastRow As Long
Dim MyValue As String
Dim CopyRange As Range
Dim sht As Worksheet
Dim Myrange As Range
Dim C As Range
' ***********************************************************************
' Add A New Worksheet After The Last Existing Worksheet
' ***********************************************************************
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Results"
MyValue = "WhatImLookingFor"
' ***********************************************************************
' Scan Through Each Worksheet (Except The Last One Just Added)
' ***********************************************************************
For x = 1 To Sheets.Count - 1
Set sht = Sheets(x)
LastRow = sht.Cells(Rows.Count, "B").End(xlUp).Row
Set Myrange = sht.Range("B1:B" & LastRow)
For Each C In Myrange
If UCase(C.Value) = UCase(MyValue) Then
If CopyRange Is Nothing Then
Set CopyRange = C.EntireRow
Else
' ***********************************************************************
' Use The Union Command To Combine Ranges
' ***********************************************************************
Set CopyRange = Union(CopyRange, C.EntireRow)
End If
End If
Next C
' ***********************************************************************
' Copy The Union of Values To the Results Worksheet
' ***********************************************************************
If Not CopyRange Is Nothing Then
LastRow = Sheets("Results").Cells(Rows.Count, "A").End(xlUp).Row + 1
CopyRange.Copy Destination:=Sheets("Results").Range("A" & LastRow)
Set CopyRange = Nothing
End If
' ***********************************************************************
' Prepare To Scan The Next Worksheet
' ***********************************************************************
Next x
End Sub