Excel宏可在工作表中查找单元格并在另一工作表中复制整行

时间:2019-11-05 08:14:21

标签: excel vba

我有一个约有5万行的excel工作表,我需要一个宏来搜索该工作表中的单元格,如果找到它可以将整行复制到另一个工作表中,我的问题是关键字可能在多行因此,如果有4个带有该关键字的单元格,我需要它复制所有4行并将其粘贴到另一张纸上

Sub saca()

Dim intPasteRow As Integer
intPasteRow = 2
Dim ceva As Range
Dim FirstAddress As String
Dim intRow As Integer

Sheets("Sheet2").Select
Columns("A:AV").Select
On Error Resume Next
Set ceva = Selection.Find(What:="m762", After:=ActiveCell, LookIn:= _
    xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
    xlNext, MatchCase:=True, SearchFormat:=True).Activate
If Not ceva Is Nothing Then
    FirstAddress = ceva.Address
    Do
        Set ceva = Selection.FindNext(ceva).Activate
    Loop While Not ceva Is Nothing And ceva.Address <> FirstAddress
End If

intRow = ActiveCell.Row
Rows(intRow & ":" & intRow).Select
Selection.Copy

Sheets("Sheet1").Select
ActiveSheet.Paste

End Sub

到目前为止,它在Sheet2中搜索“ m762”,但是它仅复制带有“ m762”单元格的第一行,而不是选择所有的行...我找不到一种方法来使它选择所有带有“ m762”的行m762”

1 个答案:

答案 0 :(得分:0)

尽管不是最佳或最快的解决方案,但这是一个基本的For Loop宏,它将循环遍历每个单元格,当找到条件时,它将把Sheet2中的行复制到下一个空行通过将值直接从Sheet1设置为Sheet2,在Sheet1中进行设置。然后它将继续并复制找到条件的每一行。

Dim cel As Range, lRow As Long

    For Each cel In ThisWorkbook.Sheets("Sheet2").Range("A2:AV" & Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row)
        If cel.Value = "m762" Then
            lRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

            ThisWorkbook.Sheets("Sheet1").Cells(lRow + 1, 1).Resize(, 48).Value = ThisWorkbook.Sheets("Sheet2").Cells(cel.Row, 1).Resize(, 48).Value
        End If
    Next cel