Loop through rows and Paste where...

[gheyman]

I have this code that I got to work all the way up to where I need to check and see if there is an "X" then paste value

Can someone help me with this? Please.

Sub SelectCostSourceData()

Application.ScreenUpdating = False

    Sheets("3 Source Selection").Visible = True

    Dim sh97 As Worksheet
    Dim tblSourceList As ListObject
    Dim lastrow As ListRow
    Dim SCR As Variant
    Dim fnd As Variant
    Dim LR9 As Long
    Dim LR9a As Long
    Dim LR9b As Long
    
    Dim fndIndex As Range
    Set fndIndex = Range("B:B").Find("Index", LookIn:=xlValues, lookat:=xlWhole)
       
    Set sh9 = Sheet9
    Set tblSourceList = sh9.ListObjects("CostSource_Selections")

    LR9 = Cells(Rows.Count, "B").End(xlUp).Row


    If Intersect(ActiveCell, Range("B" & fndIndex.Row + 1, Range("AJ" & LR9))) Is Nothing Then
            MsgBox "You must select a Cost Source in column E (VendorName).  Select a valid Cell, then click Select"
        Exit Sub
    End If


    LR9a = Sheets("Selected CostSource").Cells(Rows.Count, "A").End(xlUp).Row
        LR9b = LR9a + 1
    
    Sheets("3 Source Selection").Range("C" & ActiveCell.Row & ":" & "C" & ActiveCell.Row).Copy


'********************************
Dim iRows As Integer
Dim iCount As Integer

'Select the current row
    Sheet9.Range("C16").Activate
'ActiveCell.EntireRow.Select

    On Error GoTo Last
        iRows = Sheet2.Range("B12").Value

'Loop through column B.  If column B = "X" then paste Value

        For iCount = 1 To iRows

            If Cells(B, iCount) = "X" Then Cells(B, iCount).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False


        Next iCount
Last:         Exit Sub


'Sheets("Selected CostSource").Range("A" & LR9b).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'        :=False, Transpose:=False
        
    Application.CutCopyMode = False

'deactivated while coding
'Sheets("Selected Part").Visible = xlSheetVeryHidden



'         Sheets("3 Source Selection").Select
'         Range("C10").Select


    
Application.ScreenUpdating = True


    
End Sub

 

[Max1616]

Update your code to this and give it a try:

            If Cells(iCount,2) = "X" Then Cells(iCount,2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

For Cells objects, the syntax is this: Cells(Row#,Column#)

 

[gheyman]

Thanks, Max. That kind of worked. But it only pasted the value into the first "X" row. It didn't loop through to paste in other where there were X's in other rows.

 

[gheyman]

OK so the current value in iRows = Sheet2.Range("B12").Value is 24. It seems to be looping through row 24.

What I am trying to do is loop from row 15 down 24 rows.

 

[Max1616]

Try this:

        For iCount = 15 To 15 + iRows

            If Cells( iCount, 2) = "X" Then Cells(iCount, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False


        Next iCount

 

[gheyman]

Thank you