Копирование строки плюс следующие 3

Question

У меня есть код, который отлично работает. Он анализирует все мои листы и находит строку в столбце A, которую я хочу, и вставляет ее в указанный лист. Однако мне нужно скопировать указанную строку плюс следующее количество строк X. Может ли кто-нибудь помочь мне в этом?

Sub FindValues() 
    Dim ws As Excel.Worksheet 
    Dim LastRow As Long 
    Dim i As Integer 

    For Each ws In Application.ThisWorkbook.Worksheets 
     LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row 
     i = 1 

     Do While i <= LastRow 
      If ws.Range("A" & i).Value = "OwnershipType Ownership Type" Then 
       ws.Rows(i).Copy Sheets("Summary").Range("A2") 
       i = i - 1 
       LastRow = LastRow - 1 
      End If 
      i = i + 1 
     Loop 
    Next 


End Sub 

Answer 1

Вы можете изменить диапазон строк копируется на эту строку следующим образом:

ws.Rows(i & ":" & i + 3).Copy Sheets("Summary").Range("A2") 

Если матч был найден в строке 1, например, код будет отображаться как ws.Rows(1:4).Copy

Answer 2

Я внес некоторые незначительные изменения. Просто добавлено (i + количество строк для копирования). Проверьте приведенный ниже код: В коде Integer copyrw вы можете установить это целое число, чтобы скопировать количество строк.

Sub FindValues() 
    Dim ws As Excel.Worksheet 
    Dim LastRow As Long 
    Dim i As Integer 
    Dim copyrw as Integer 

copyrw = 3 
For Each ws In Application.ThisWorkbook.Worksheets 
    LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row 
    i = 1 

    Do While i <= LastRow 
     If ws.Range("A" & i).Value = "OwnershipType Ownership Type" Then 
      ws.Rows(i & ":" & i + copyrw).Copy Sheets("Summary").Range("A2") 
      i = i - 1 
      LastRow = LastRow - 1 
     End If 
     i = i + 1 
    Loop 
Next 


End Sub