Copy values from loop and paste in different worksheet

[cwb1021]

Hello Experts,

This is my first attempt with VBA and I need a little help with the loop syntax.

I'm attempting to write a sub procedure that will loop through a range of cells in a column on the active worksheet, copy a value from that row, and paste it on to another worksheet in the same workbook.

So basically, if a value is identified as less than or equal to the variable ScanRadius in column 7 of worksheet Sample, I would like for the sub procedure to copy a value from the cell A1 in that same row, and paste it to another worksheet (OffsetList).

I've tried multiple variations of this and each time the procedure stalls at the "copy" command.

Sub TestLoopAgain()
Dim cell As Range, OffsetRange As Range
Dim ScanRadius As Single
Dim wsSample As Worksheet: Set wsSample = Worksheets("Sample")
Dim wsOffsetList As Worksheet: Set wsOffsetList = Worksheets("OffsetList")

'Selects Offset Distance column in sample data for comparison against input scan radius

Application.Workbooks("MacroTest.xlsm").Worksheets("Sample").Activate
ActiveSheet.Columns(7).Select

'Limits data scanned to last row of used section - eliminates scanning of blank cells
Set OffsetRange = Intersect(Selection, ActiveSheet.UsedRange)

'Sets variable ScanRadius to value input on worksheet
ScanRadius = Application.Workbooks("MacroTest.xlsm").Worksheets("ScanRadius").Range("c3")

'Compares each offset distance to scan radius and returns values within radius
For Each cell In Selection
   If cell.Value <= ScanRadius Then
         wsSample.Range("A2").Copy                                                                     '<===============Stuck here - debugger will not go past this line
         wsOffsetList.Activate                                                                                '<=============Im not sure about the code after this.  I have not been able to test it since the procedure stalls at copy.
         wsOffsetList.Range("A" & swOffsetList.Range("A" & Rows.Count).End(xlUp).Row + 1).Select
         Selection.PasteSpecial Paste:=xlPasteValues
         
   End If
Next cell
End Sub

Any help would be greatly appreciated. Please let me know if I am leaving out any necessary information.

Thanks,

Chris

[mdmackillop]

For Each cell In Selection - this will cycle through each cell in column 7
wsSample.Range("A2").Copy - This will copy the same cell every time
I'm guessing here with a simplified code

Option Explicit
Sub TestLoopAgain()
Dim cell As Range, OffsetRange As Range
Dim ScanRadius As Single
Dim wsS As Worksheet
Dim wsO As Worksheet
    
    Set wsS = Worksheets("Sample")
    Set wsO = Worksheets("OffsetList")
    Set OffsetRange = Intersect(wsS.Columns(7), wsS.UsedRange)
    ScanRadius = Worksheets("ScanRadius").Range("c3")
    For Each cell In OffsetRange
        If cell.Value <= ScanRadius Then
            cell.Offset(, -6).Copy
            wsO.Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
        End If
    Next cell
End Sub

[cwb1021]

mdmackillop,

Thanks so much for your reply. I'll try it out and post the results.

Thanks,

Chris

[cwb1021]

mdmackillop,

This worked perfectly. I appreciate the help.

Thanks,

Chris