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.
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