전체 행을 복사하는 코드 편집

Question

내가해야 할 일의 대부분을 수행하는 코드가 몇 개 발견되었지만 변수가 발견 된 셀뿐만 아니라 전체 셀의 행을 복사해야합니다. 발생. 데이터를 포함하는 행의 마지막 셀에 변수를 찾은 셀을 복사하기 위해 편집하는 방법에 대한 의견이 있으십니까?

Sub Copy_To_Another_Sheet_1() 
Dim FirstAddress As String 
Dim MyArr As Variant 
Dim Rng As Range 
Dim Rcount As Long 
Dim I As Long 
Dim NewSh As Worksheet 
Dim Initiatives As Worksheet 
    Set Initiatives = ThisWorkbook.Worksheets("Initiatives") 

With Application 
    .ScreenUpdating = False 
    .EnableEvents = False 
End With 

MyArr = Array("Components") 


Set NewSh = Worksheets.Add 

With Initiatives.Range("B3:B500") 

    Rcount = 0 

    For I = LBound(MyArr) To UBound(MyArr) 


     Set Rng = .Find(What:=MyArr(I), _ 
         After:=.Cells(.Cells.Count), _ 
         LookIn:=xlFormulas, _ 
         LookAt:=xlPart, _ 
         SearchOrder:=xlByRows, _ 
         SearchDirection:=xlNext, _ 
         MatchCase:=False) 
     If Not Rng Is Nothing Then 
      FirstAddress = Rng.Address 
      Do 
       Rcount = Rcount + 1 

       Rng.Copy NewSh.Range("A" & Rcount) 



       Set Rng = .FindNext(Rng) 
      Loop While Not Rng Is Nothing And Rng.Address <> FirstAddress 
     End If 
    Next I 
End With 

With Application 
    .ScreenUpdating = True 
    .EnableEvents = True 
End With 
End Sub 

Answer 1

변경이 줄을이 속으로

Rng.Copy NewSh.Range("A" & Rcount) 

: 그냥 일을 반대로

이

Rng.EntireRow.Copy NewSh.Rows(Rcount) 

이, 인덱스 Rcount의 전체 행에 RNG의 전체 행을 복사합니다 각각의 단일 세포.