Перебирайте ячейки в диапазоне, проверяйте состояние и сохраняйте результаты на разных с / х

Question

Я пытаюсь построить цикл, который будет проходить через каждую ячейку строки и каждую строку в диапазоне, проверить, является ли значение в каждой ячейке «яблочным», и это так, скопировать дату, для которой была проверена ячейка и сохраните дату на отдельном листе рядом с идентификатором, для которого была выполнена проверка. Буду признателен за помощь в этом. Спасибо. введите описание изображения здесь

Лист1 Лист2

Answer 1

Sub test()

    Dim usedrows, usedcolumn, i, j As Integer

    usedrows = ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row
    usedcolumn = ActiveSheet.Range("AZZ1").End(xlToLeft).Row

    For j = 4 To usedcolumn     'loop through columns
        For i = 4 To usedrows      'loop through rows
            If Cells(i, usedcolumn) = "Apple" Then

                Range("A" & i).Copy   'Copy the ID
                'paste it
                Cells(3, j).Copy ' Copy the date
                'paste it
            End If
            If Range("A" & i) = "" Then  'if end of the row loop next column
                Exit For
            End If
        Next
Next

End Sub