행 복사 다음 복사 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

당신은 행의 범위를 수정할 수는과 같이이 줄에 복사 : 경기는 1 행에서 발견 된 경우

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

예를 들어, 코드가 ws.Rows(1:4).Copy

Answer 2

로 렌더링 것 나는 사소한 수정을했다. (i + 복사 할 행 수)이 추가되었습니다. 아래 코드를 확인하십시오 : 사용 된 정수 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