How to Find And Write Cells Based on Criteria

How to find and write cells based on criteria

Requirement:

For the below table, The user is attempting to create VBA that locates the negative values in column "header6", then copies those values to a separate worksheet in the same workbook, and in a designated column and row. The problem the user has encountered is that the user is unable to copy the corresponding values from column "header2" into the same worksheet that the negative values were copied, and in a designated column and row alongside the negative values (or any other place of my choosing).

The user found code that enables the coping of the entire row when the negative values are located, but that's not what the user wants to do.

In the below table, the negative values are located in column "header6". As an example, the user wants to copy the value of "-2" found in column "header6" and cell "B2" from "Workbook A, Worksheet 1" into "Workbook A, Worksheet 2".

The user needs this to continue down column"header6" and for every negative value it copies and appends the negative values and the associated cell data found in column "header2".

header1	header2	header3	header4	header5	header6
A2	B2	C2	D2	E2	-2
A3	B3	C3	D3	E3	3
A4	B4	C4	D4	E4	4
A5	B5	C5	D5	E5	-1
A6	B6	C6	D6	E6	-7
A7	B7	C7	D7	E7	1

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/150081-find-and-write-cells-based-on-criteria

Solution:

Code:

Sub x()
     
Dim r As Long
     
With Sheets("Sheet1")
    For r = 2 To .Range("F" & Rows.Count).End(xlUp).Row
        If .Cells(r, 6) < 0 Then
            Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp)(2).Value = .Cells(r, 2).Value
            Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp)(2).Value = .Cells(r, 6).Value
        End If
    Next r
End With

End Sub

Obtained from the OzGrid Help Forum.

Solution provided by StephenR.