копировать и вставлять с одного листа на другой с помощью поиска и цикла

Question

Я пытаюсь найти ключевое слово в sht1, скопировать весь диапазон от sht1 до sht2 и убедиться, что sht2 начинает вставлять с rowp 10. Затем цикл должен выполнить поиск по sht1 для того же ключевого слова, а для sht2 продолжить цикл до rowp 11 до конца цикла. Для sht1 это нормально, но когда он вставляется в sht2, результаты не зацикливаются, а как-то не получаются. пространства по сравнению с шт1. не уверен, как решить это. ниже мои коды. был бы признателен за некоторые советы =)

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



End If

row = row + 1
rowp = rowp + 1
Loop

End Sub

Answer 1

Если я правильно понимаю вашу потребность, вы должны увеличивать 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