Better than ActiveCell 1

[Mantle51]

Hello,
I have the following(partial macro) that works, but oft been told to steer clear of ActiveCell property. Any replacement suggestions for this somewhat convoluted code that copies values from disparate parts of a sheet, then pastes into another.


Do

Set tempR = Range(ActiveCell, ActiveCell.Offset(5, 1))
tempR.Select
Selection.Copy
Sheets("Rpt_Dump").Select
ActiveSheet.Paste
ActiveCell.End(xlDown1).Select
ActiveCell.Offset(1, 0).Select

Sheets(i).Select
ActiveCell.Offset(10, 6).Select

Do
If ActiveCell.Value = "x" Then
Selection.EntireRow.Copy
Sheets("Rpt_Dump").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
Sheets(i).Select
ActiveCell.Offset(1, 0).Select
Else: ActiveCell.Offset(1, 0).Select
End If

Loop Until ActiveCell(1, -1).Value =

 

[SkipVought]

Hi,

Here's an example...

Sub test()
    Dim lRow As Long, iCol As Integer, lLastRow As Long
    Dim wsThis As Worksheet, rng As Range

    'lets assume that the starting point is the upper-lh corner of the usedrange
    Set wsThis = ActiveSheet
    
    With wsThis
        With .UsedRange
            lRow = .Rows
            iCol = .Column
        End With
        lLastRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
    End With
    
    Set rng = .Cells(lRow, iCol)
    
    Do
        Range(rng, rng.Offset(5, 1)).Copy _
            Sheets("Rpt_Dump").Cells(Sheets("Rpt_Dump").Cells(1, 1).End(xlDown) + 1, 1)
        
        Set rng = rng.End(xlDown)
        Set rng = rng.End(xlDown)
    
        lRow = rng.Row
    Loop Until lRow > lLastRow
       
    Set rng = Nothing
    Set wsThis = Nothing
End Sub

Skip,

_[red][/red]