Copy to another sheet in For-loop with Criteria

[forrestli]

Hi. I am trying to copy cells to another columns based on the row number of selection.
For example, first I input row 16, then the Notation is "A". Second, above row 16, all the rows with "A" will be selected. Third, these rows' value will be copied to another sheet.
I prefer For-if -loop, because i want to past them one by one from the Row selected, from the bottom to the top.

Sub CopySelected()

Dim A As Long: A = 4
Dim B As Long: B = 2
Dim RowNo, Notation

With ActiveSheet
    RowNo = Application.InputBox("Select row to be input", Type:=1)

    If VarType(RowNo) = vbBoolean Then
       Exit Sub
    Else
       Notation = .Cells(RowNo, 6).Value
    End If

    For A = RowNo To 4
        If .Cells(A, 1).Value = Notation Then
         .Cells(A, 2).Value.Copy Sheet2.Cells(B, 1)
         B = B + 1
        End If
    Next A
End With

End Sub

 

[Marc L]

Hi, a VBA demonstration for starters :​

Sub Demo1()
    Dim L&, R&, T$
        Application.ScreenUpdating = False
    With Sheet2
            L = .UsedRange.Rows.Count
            R = ActiveCell.Row
            T = Cells(R, 1).Text
        For R = R To 2 Step -1
            If Cells(R, 1).Text = T Then
                L = L + 1
                Cells(R, 1).Copy .Cells(L, 1)
            End If
        Next
    End With
        Application.ScreenUpdating = True
End Sub

 

[forrestli]

Mr. Marc

You are my lifesaver! My visa is almost end and my boss is using this small task to challenge my probation. Thank you so much from Canada.

Sub Demo1()
    Dim RowNo
    RowNo = Application.InputBox("Select row to be input", Type:=1)
    Dim A, RowMix, B
        Application.ScreenUpdating = False
    With ActiveSheet
            
            RowMix = .Cells(RowNo, 6).Text
            A = RowNo
            B = 2
        
        For A = RowNo To 2 Step -1
            If .Cells(A, 6).Text = RowMix Then
                .Cells(A, 19).Copy Sheets("DataEntry").Cells(B, 8)
                B = B + 1
            End If
        Next
    End With
        Application.ScreenUpdating = True
End Sub