Copying values from one sheet based on condition to another workbook - excel

Question

I've written some code that assigns each item in a list a code based on row #. What I want to do from there is choose a copy all information from each row that corresponds with a chosen code, then paste it to another workbook. I've been having some trouble. Here's the code:
Sub LSHP_Distribute()
Dim wbLSHP As Workbook
Dim wsLSHP As Worksheet
Dim CodeRange As Range
Dim FirstRow As Long
Dim LastRow As Long
Dim wbTEST As Workbook
Set wbLSHP = ActiveWorkbook
Set wsLSHP = wbLSHP.Sheets("Sheet1")
'Generate codes for newly added items
Application.ScreenUpdating = False
'Turn off screen updating
With wsLSHP
FirstRow = .Range("F3").End(xlDown).Row + 1
LastRow = .Range("B6", .Range("B6").End(xlDown)).Rows.Count + 5
Set CodeRange = .Range("$F$" & FirstRow, "$F$" & LastRow)
End With
For Each cell In CodeRange
If cell = "" Then
If cell.Row Mod 3 = 0 Then
cell.Value = "1"
ElseIf cell.Row Mod 3 = 1 Then
cell.Value = "2"
ElseIf cell.Row Mod 3 = 2 Then
cell.Value = "3"
Else
End If
End If
Next cell
'Open Spreadsheets to Distribute Items
Dim PasteRow As Long
Dim i As Integer
Set wbTEST = Workbooks.Open(Filename:="V:\Test.xlsx")
PasteRow = wbTEST.Sheets("Sheet1").Range("B6").End(xlDown).Row + 1
Below is where I'm having the problem
wbLSHP.Activate
For Each cell In CodeRange
If cell = "1" Then
Range(ActiveCell.Offset(0, -5), ActiveCell.Offset(0, 20)).Select
Selection.Copy
wbTEST.Sheets("Sheet1").Cells(PasteRow, 1).PasteSpecial xlPasteValues
PasteRow = PasteRow + 1
Else
End If
Next cell
End Sub
First problem is the For loop isn't copying the correct range in "CodeRange", the second problem is it only copies once before I get an Automation Error. Let me know if you have any questions, or know of a more efficient way to write this code.
Thanks so much for your time!

Answer 1

Your range is defined to Start in F3 and end in BSomething, but you store to CodeRange only the F column.
Set CodeRange = .Range("$F$" & FirstRow, "$F$" & LastRow)
Try using:
Set CodeRange = .Range("$B$" & FirstRow, "$F$" & LastRow)
I suggest instead of Copy and Paste, assign the value to a variable and put the value of the variable on wbTEST.