Почему скрипт VBA не копирует/перемещает записи в следующую пустую строку?

Я реализовал функцию в VBA со следующими целями:

Текущая проблема: Когда скрипт VBA запускается/выполняется, набор данных копируется в соответствующие столбцы, но вставляется в диапазон от 20 000 до 80 000 строк, превышающий тысячи пустых строк. Я пытался выполнить скрипт несколько раз, но вставка продолжает обходить все пустые ячейки и добавляет набор данных дальше вниз по вкладке моего листа индекса.

Фиктивная электронная таблица

Sub MoveListToIndex()

'Find the last used row in both sheets and copy and paste data below existing data.

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long

    Dim Answer As VbMsgBoxResult
    
    Answer = MsgBox("Are you sure you want to Submit the List?", vbYesNo, "Submit List")
    
        If Answer = vbYes Then

Dim D As Range

Set D = Worksheets("Single Column").Range("D7:D400")

  'Set variables for copy and destination sheets
  Set wsCopy = Worksheets("Single Column")
  Set wsDest = Worksheets("Index")

For Each cell In D

If cell.Value <> "" Then

  '1. Find last used row in the copy range based on data in column D
  lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "D").End(xlUp).Row
    
  '2. Find first blank row in the destination range based on data in column AA
  'Offset property moves down 1 row
  lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "AA").End(xlUp).Offset(1).Row

  '3. Copy & Paste Data
  wsCopy.Range("A8:F400" & lCopyLastRow).Copy
  wsDest.Range("AA" & lDestLastRow).PasteSpecial xlPasteValuesAndNumberFormats

End If
Next cell

Application.ScreenUpdating = True
            MsgBox "The List has been Successfully Added!"
 
End If
End Sub