excelvbacopycell

If Cell contains specific text in col A copy cell from Col C into Col F stacked


I am working on code where if in Column "A"="test" then to copy cell from Col C into Col F but without spaces . Can someone please help?

Sub FindValuePaste()

    Dim FndRng As Range
    Dim cll As Range

    Set FndRng = Range("A3:A9")

    For Each cll In FndRng
        If cll.Value = "test" Then
           ' cll.Offset(0, 5) = cll.Offset(0, 2).Value
            Range("F1").Offset(1) = cll.Offset(0, 2).Value
        End If
    Next cll

End sub

Appreciate your help and thank you in advance!

Excel view in below screenshot


Solution

  • Sub FindValuePaste()
        Dim FndRng As Range
        Dim cll As Range
        Dim lastRow as Long, oSht as Worksheet
        Set oSht = ActiveSheet ' modify as needed
        lastRow = oSht.Cells(oSht.Rows.Count, "F").End(xlUp).Row 
        If len(oSht.Range("F" & lastRow)) > 0 Then  lastRow = lastRow + 1
        Set FndRng = oSht.Range("A3:A9")
    
        For Each cll In FndRng
            If cll.Value = "test" Then
               ' cll.Offset(0, 5) = cll.Offset(0, 2).Value
                oSht.Range("F" & lastRow).Value = cll.Offset(0, 2).Value
                lastRow = lastRow + 1            
            End If
        Next cll
    End sub
    

    Sub FindValuePaste2()
    
        Dim FndRng As Range
        Dim cll As Range
        Dim lastRow As Long, oSht As Worksheet
        Set oSht = ActiveSheet ' modify as needed
        lastRow = Application.CountA(oSht.Columns("F")) + 1
        Set FndRng = oSht.Range("A3:A9")
        For Each cll In FndRng
            If cll.Value = "test" Then
               ' cll.Offset(0, 5) = cll.Offset(0, 2).Value
                oSht.Range("F" & lastRow) = cll.Offset(0, 2).Value
                lastRow = lastRow + 1
            End If
        Next cll
    
    End Sub