VBA宏-复制数据

Question

I am working on pulling data from cells in Sheet1 to Sheet2 and I have the correct Macro for the data copy, however, I need to have specific entries pulled based on information in another cell.

I am starting on cell A14 for my code and all of the work will be done in column A. Basically, I need to start at cell A14 in Sheet1 and pull every 5th cell and copy it into Sheet2 based on criteria found two cells below the cell I am determining if I need to copy or not. The criteria of whether or not to copy the data from 2 cells above is if the cell contains "Choose an answer" or not.

For example, x+5=n If n+2="Choose and answer", copy n to Sheet2

The macro I have currently can be found below.

Sub CopyNthData()
Dim i As Long, icount As Long
Dim ilastrow As Long
Dim wsFrom As Worksheet, wsTo As Worksheet

Set wsFrom = Sheets("Sheet1")
Set wsTo = Sheets("Sheet2")
ilastrow = wsFrom.Range("A1000000").End(xlUp).Row
icount = 1

For i = 14 To ilastrow Step 5
    wsTo.Range("A" & icount) = wsFrom.Range("A" & i)
    icount = icount + 1
Next i
End Sub

Image of Sheet

Answer 1

Something like this?

The principle is to use Offset. You can use it for the range to compare and the range to retrieve if required.

Given uncertainty of your comparison it seems

wsFrom.Cells(i, 1).Offset(2, 0)) = "choose an answer" 

Compares two rows above current, whereas

wsFrom.Cells(i, 1).Offset(-2, 0)) = "choose an answer" 

Compares two rows below

If you then want to copy something other than current cell, you can Offset from current cell eg

wsTo.Range("A" & icount) = wsFrom.Range("A" & i).Offset(1,0)

Example above, you then copy the value from the cell above the current.

In Offset the first number is the number of rows to move from current position and the second is the number of columns.

Option Explicit

Sub CopyNthData()

    Dim i As Long, icount As Long
    Dim ilastrow As Long
    Dim wsFrom As Worksheet, wsTo As Worksheet

    Set wsFrom = Sheets("Sheet1")
    Set wsTo = Sheets("Sheet2")

    ilastrow = wsFrom.Range("A1000000").End(xlUp).Row
    icount = 1

    For i = 14 To ilastrow Step 5

         If LCase$(Trim$(wsFrom.Cells(i, 1).Offset(2, 0))) = "choose an answer" Then
            wsTo.Range("A" & icount) = wsFrom.Range("A" & i)
            icount = icount + 1
        End If

    Next i
End Sub