Если критерии соответствуют, скопируйте и вставьте в определенные строки

Question

У меня проблемы с моим кодом: вот в чем дело, если в столбце H = "Да" скопировать содержимое ячейки из строки "A" на другой лист в строке "A", но начиная с первой строки.

Проблема заключается в следующем: я хочу вставить содержимое в первую пустую строку после моего заголовка, который находится в ячейке «A7», а не в соответствующую строку, где встречаются критерии.Также, если есть способ избежать пустых ячеек между строками после копирования и вставки, чтобы организовать их.

Option Explicit

Private Sub CommandButton1_Click()

'submacro which copies data over columns
    Dim lastRow As Long, i As Long
    'determine last row in column H
    lastRow = Cells(Rows.Count, "H").End(xlUp).Row
    For i = 1 To lastRow


        'if Yes in H then copy from cell B in OFCE to cell B in DASHBOARD in    current row
        If Worksheets("OFCE").Cells(i, "H").Value = "Yes" Then
        'To paste from Dashboard tab to OFCE tab
            Worksheets("Dashboard").Cells(i, "A").Value = Worksheets("OFCE").Cells(i, "A").Value
        End If
    Next


End Sub

После этого мне придется перенести не только одну строку, но и многие другие.

Answer 1

Кнопка обновления запускает код от вас @ Error1004, но теперь мне нужно не только передавать, но и проверять и обновлять переданные данные без повторяющихся записей, просто добавляя новые, которые соответствуют критериям, но все это снова копируется вследующие строки, как вы можете видеть на изображениях ниже с листа OFCE, откуда поступают данные, и второй, где данные копируются и вставляются.

первая вкладка

вторая вкладка с повторяющимися данными

Answer 2

Я не уверен, полностью ли понимаю ваши потребности, но это может помочь:

Option Explicit

Private Sub CommandButton1_Click()

        Dim LastRowH As Long, i As Long, LastRowA As Long

LastRowH = Worksheets("OFCE").Cells(Worksheets("OFCE").Rows.Count, "H").End(xlUp).Row

For i = 1 To LastRowH

    If Worksheets("OFCE").Cells(i, "H").Value = "Yes" Then

        LastRowH = Worksheets("Dashboard").Cells(Worksheets("Dashboard").Rows.Count, "A").End(xlUp).Row

        Worksheets("Dashboard").Cells(LastRowH + 1, 1).Value = Worksheets("OFCE").Cells(i, 1).Value

    End If

Next i

End Sub