Vba 无法停止将行从一张图纸导入到另一张图纸的循环

我在循环中遇到了一个问题。我想导入第一个单元格中包含“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

此版本已优化（不使用For循环）

此版本已优化（不使用For循环）

---

有人能帮我一下吗？你说第一排不贴是什么意思？你想要它做什么？我想要它从第6行粘贴，但是它从床单的底部粘贴了很多次（6或7次）。你的意思是从第6行开始？是的，完全是从B6开始。有人能帮我吗？你说它不从第一行粘贴是什么意思？你希望它做什么？我希望它从第6行粘贴，但它从纸的底部粘贴，并粘贴多次（6或7次）。你的意思是从第6行开始？是的，完全从B6开始

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

Option Explicit

Public Sub refreshAnalyse()
    Dim ws1 As Worksheet, ws2 As Worksheet, lr1 As Long

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

    ws2.Range("B6:AP" & ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row).Clear
    lr1 = ws1.Cells(ws1.Rows.Count, 2).End(xlUp).Row

    Application.ScreenUpdating = False
        ws1.Range("A1:A" & lr1).AutoFilter Field:=1, Criteria1:="x"
        ws1.Range("B2:AP" & lr1).SpecialCells(xlCellTypeVisible).Copy

        ws2.Range("B6").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        ws1.Range("A6:A" & lr1).AutoFilter
        ws2.Activate: ws2.Cells(1, 1).Activate
    Application.ScreenUpdating = True
End Sub