编辑代码以复制整行

时间:2016-07-21 17:26:14

标签: vba excel-vba excel

我找到了一些代码,它完成了我需要它做的大部分工作,但是我需要复制它找到变量出现的整行,而不仅仅是它找到事件的单元格。有关如何编辑它以将其找到变量的单元格复制到包含数据的行中的最后一个单元格的任何想法吗?

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

1 个答案:

答案 0 :(得分:1)

更改此行:

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

进入这个:

Rng.EntireRow.Copy NewSh.Rows(Rcount)

这会将Rng的整行复制到索引Rcount的整行中,而不是只对每个行执行一个单元格。