行全体をコピーするコードを編集する

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の行全体をコピーします。それぞれの単一細胞。