vba - 无法停止将行从工作表导入到另一个工作表的循环

Question

我在循环中有问题。我想导入第一个单元格中包含“X”的行，但是:

它不会从第一行粘贴它们

粘贴太多次

有人能帮我吗 ？

 Sub refresh()
    '
    ' refresh Macro
    '
    ' Touche de raccourci du clavier: Ctrl+y
    '
    Dim LastRow As Integer, i As Integer
    Dim wksSrc As Worksheet, wksDest As Worksheet
    Dim lngRow As Long

    Set wksSrc = ThisWorkbook.Worksheets("Scénarios de menace")
    Set wksDest = ThisWorkbook.Worksheets("Analyse de risque S")
    Application.Calculation = xlAutomatic
    Application.DisplayAlerts = False
    wksDest.Range("A6:AP1000").Delete
    Application.DisplayAlerts = True
    wksDest.Range("A6:AP1000").ClearContents 'Works directly, without selection

    lngRow = wksDest.Cells(wksDest.Rows.Count, 2).End(xlUp).Row + 1

    For i = 2 To wksSrc.Range("A" & wksSrc.Rows.Count).End(xlUp).Row

      If wksSrc.Cells(i, 1) = "X" Then
        wksSrc.Range(wksSrc.Cells(i, 2), wksSrc.Cells(i, 20)).Copy

        wksDest.Range("B" & lngRow).PasteSpecial xlPasteValuesAndNumberFormats
        Application.CutCopyMode = False
        lngRow = lngRow + 1
      End If
    Next i
End Sub

Answer 1

sub refresh()    
Dim LastRow As Integer, i As Integer
Dim wksSrc As Worksheet, wksDest As Worksheet
Dim lngRow As Long

Set wksSrc = ThisWorkbook.Worksheets("Scénarios de menace")
Set wksDest = ThisWorkbook.Worksheets("Analyse de risque S")

wksDest.Range("A6:AP1000").Delete
wksDest.Range("A6:AP1000").ClearContents 'Works directly, without selection

lngRow = 6
LastRow = wksSrc.Range("A" & wksSrc.Rows.Count).End(xlUp).Row

For i = 2 To LastRow

  If wksSrc.Cells(i, 1) = "X" Then
    wksSrc.Range(wksSrc.Cells(i, 2), wksSrc.Cells(i, 20)).Copy
    wksDest.Range("B" & lngRow).PasteSpecial xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False
    lngRow = lngRow + 1
  End If
Next i
end sub