Excel 使用搜索和循环从一张图纸复制并粘贴到另一张图纸

我基本上是在尝试从sht1搜索关键字，复制从sht1到sht2的整个范围，并确保sht2从

第10行开始粘贴。然后循环应在sht1中搜索相同的关键字，并在sht2中继续循环到第11行，直到循环结束。对于sht1是可以的，但是当它粘贴到sht2上时，结果不是循环的，而是以某种方式获得与sht1相同的空间数。不知道怎么解决。
下面是我的代码。如果您能给我一些建议，我将不胜感激

如果我正确理解您的需要，您应该仅在正匹配后增加
rowp
，以便在前面的
sht2
行之后继续复制。试着这样做：

Sub shipshore()

Dim wb As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim row As String
Dim rowp As String

row = 2
rowp = 10


Set wb = ThisWorkbook
Set sht1 = wb.Sheets("datasheet")
Set sht2 = wb.Sheets("Sheet1")

Do Until sht1.Range("G" & CStr(row)) = ""

  If sht1.Range("F" & CStr(row)) = "abc" Then
    Sheets("datasheet").Range("A" & CStr(row) & ":J" & CStr(row)).Copy

    Sheets("Sheet1").Range("A" & CStr(rowp) & ":J" & CStr(rowp)).PasteSpecial _
           Paste:=xlPasteValues
    rowp = rowp + 1    
  End If

  row = row + 1

Loop

End Sub

另一个问题：是否可以运行另一个if语句，而不必再次遍历循环？代码变得低效且缓慢..也许您可以尝试加快整个宏的执行速度，在开始时添加：Application.ScreenUpdate=False Application.EnableEvents=False Application.Calculation=xlCalculationManual，在宏应用程序结束时添加。Calculation=xlCalculationAutomatic Application.EnableEvents=TrueApplication.screenUpdate=True。此外，您可以使用Range.Find（）而不是逐行更改循环的逻辑
Sub shipshore()

Dim wb As Workbook
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim row As String
Dim rowp As String

row = 2
rowp = 10


Set wb = ThisWorkbook
Set sht1 = wb.Sheets("datasheet")
Set sht2 = wb.Sheets("Sheet1")

Do Until sht1.Range("G" & CStr(row)) = ""

  If sht1.Range("F" & CStr(row)) = "abc" Then
    Sheets("datasheet").Range("A" & CStr(row) & ":J" & CStr(row)).Copy

    Sheets("Sheet1").Range("A" & CStr(rowp) & ":J" & CStr(rowp)).PasteSpecial _
           Paste:=xlPasteValues
    rowp = rowp + 1    
  End If

  row = row + 1

Loop

End Sub