Copy and Paste Loop in VBA based on cell values - vba

Question

I am trying to create some code that looks through a range of cells and will copy and paste the cells that meet a specific parameter to a different location in the workbook.
I would like to copy anything with the letter L from "sheet5" and copy a specific range to "sheet1"
I must have something wrong with the loop part of the code because only the top of the cell range is being copied. I would like the pasting to start at row 5 and continue moving downward. Does this mean I correctly put the IRow = IRow + 1 below the paste function?
Sub Paste_Value_Test()
Dim c As Range
Dim IRow As Long
Dim rDestination As Excel.Range
Application.ScreenUpdating = False
Sheets("sheet5").Activate
For Each c In Sheets("sheet5").Range("b2", Range("N65536").End(xlUp))
If c.Value = "L" Then
Sheets("sheet5").Cells(c.Row, 2).Copy
Set rDestination = Worksheets("sheet5").Cells(5 + IRow, 12)
rDestination.Select
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
IRow = IRow + 1
End If
Next c
End Sub
I really appreciate any help on this. I'm relatively new to VBA and am going to start seriously digging in.

Answer 1

Is this what you are trying by any chance? I have commented the code so you shouldn't have any problem understanding it.
Sub Paste_Value_Test()
Dim c As Range
Dim IRow As Long, lastrow As Long
Dim rSource As Range
Dim wsI As Worksheet, wsO As Worksheet
On Error GoTo Whoa
'~~> Sheet Where "L" needs to be checked
Set wsI = ThisWorkbook.Sheets("Sheet5")
'~~> Output sheet
Set wsO = ThisWorkbook.Sheets("Sheet1")
Application.ScreenUpdating = False
With wsI
'~~> Find Last Row which has data in Col B to N
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lastrow = .Columns("B:N").Find(What:="*", _
After:=.Range("B1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
lastrow = 1
End If
'~~> Set you input range
Set rSource = .Range("B2:N" & lastrow)
'~~> Search for the cell which has "L" and then copy it across to sheet1
For Each c In rSource
If c.Value = "L" Then
.Cells(c.Row, 2).Copy
wsO.Cells(5 + IRow, 12).PasteSpecial Paste:=xlPasteValues
IRow = IRow + 1
End If
Next
End With
LetsContinue:
Application.ScreenUpdating = True
Application.CutCopyMode = False
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub