Snasui Excel Forum

Code: Select all

Sub test1()
Application.ScreenUpdating = False

Dim r1, r2, rAll, blue As Range
Dim r As Variant

Worksheets("Addresses").Select
    Set r1 = Range("a10", Range("a" & Rows.Count).End(xlUp))
    Set r2 = r1.Offset(0, 4)
    Set rAll = Union(r1, r2)

If  ********************

    For Each r In r1
        If r.Value = "Search Key:" Then
            Set blue = r.Offset(1, 1).Resize(7, 3)
                blue.Select
                Selection.Copy
        End If
    Next r
    
Else
    
    For Each r In r2
        If r.Value = "Search Key:" Then
            Set blue = r.Offset(1, 1).Resize(7, 3)
                blue.Select
                Selection.Copy
        End If
    Next r
    
End If

Application.ScreenUpdating = True
End Sub

Code: Select all

Sub MultiCopy()
Dim i As Variant

If ActiveCell.Column = 2 Then
    Range(ActiveCell.Offset(i * 11).Address(False, False) & ":" & Cells(ActiveCell.Row, ActiveCell.Column + 2).Offset(i * 11).Offset(6).Address(False, False)).Copy
Else
    Range(ActiveCell.Offset(i * 11).Address(False, False) & ":" & Cells(ActiveCell.Row, ActiveCell.Column + 3).Offset(i * 11).Offset(6).Address(False, False)).Copy
End If
End Sub

Code: Select all

Sub copy_000()
    ActiveSheet.Range("B10").Select
    Selection.Offset(1, 0).Select
    Range(Selection, Selection.Offset(6, 0)).Select
    Selection.Copy
End Sub

Sub copy_001()
    ActiveSheet.Range("B22").Select
    Selection.Offset(1, 0).Select
    Range(Selection, Selection.Offset(6, 0)).Select
    Selection.Copy
End Sub

Sub copy_002()
    ActiveSheet.Range("F22").Select
    Selection.Offset(1, 0).Select
    Range(Selection, Selection.Offset(6, 0)).Select
    Selection.Copy
End Sub

Sub copy_003()
    ActiveSheet.Range("B33").Select
    Selection.Offset(1, 0).Select
    Range(Selection, Selection.Offset(6, 0)).Select
    Selection.Copy
End Sub

Code: Select all

Sub test()
    Dim rAll As Range, r As Range
    Dim blueRange As Range, bl As Range
    With Sheets("Addresses")
        Set rAll = .Range("a10", .Range("a" & Rows.Count) _
            .End(xlUp))
        Set rAll = Union(rAll, rAll.Offset(0, 4))
    End With
    For Each r In rAll
        If r.Value = "Search Key:" Then
            Set blueRange = r.Offset(1, 1).Resize(7, 3)
            For Each bl In blueRange
                bl = UCase(bl)
            Next bl
        End If
        blueRange.Copy
        'other code
    Next r
End Sub

Code: Select all

    For Each R In Range("B23:D28,B34:D39,B45:D50,B56:D61,B67:D72,B78:D83,B89:D94,B100:D105,B111:D116,B122:D127,B133:D138,B144:D149,B155:D160,F23:I28,F34:I39,F45:I50,F56:I61,F67:I72,F78:I83,F89:I94,F100:I105,F111:I116,F122:I127,F133:I138,F144:I149,F155:I160,C15")
        R = UCase(R)
    Next R