Question

我必须写一个宏来有条件地复制某些行。如果用户在任何空单元格中输入一些数字，例如A55，如果在A1中找到该数字，则该数字将与A列（或A1）匹配，然后应选择整行。如果在A列的多个位置找到该数字，那么它应该复制所有行并将它们粘贴到新的工作表中，例如sheet2。

这是我的代码，它只访问找到A55号码的所有行，我不知道如何复制选定的行：

copyandpaste() 
    Dim x As String 
    Dim matched As Integer 
    Range("A1").Select 
    x = Worksheets("Sheet1").Range("A55") 
    matched = 0 
         Do Until IsEmpty(ActiveCell) 
        If ActiveCell.Value = x Then 
            matched = matched + 1 
        End If 
        ActiveCell.Offset(1, 0).Select 
    Loop 
    MsgBox "Total number of matches are : " & matched 
End Sub

Answer 1

这应该这样做，您可能需要在FIND命令中将 xlWhole 更改为 xlPart 。

Option Explicit

Sub CopyAndPaste()
Dim x As String, CpyRng As Range
Dim mFIND As Range, mFIRST As Range

    With Sheets("Sheet1")
        x = .Range("A55")
        On Error Resume Next
        Set mFIND = .Range("A1:A54").Find(x, LookIn:=xlValues, LookAt:=xlWhole)
        If Not mFIND Is Nothing Then
            Set CpyRng = mFIND
            Set mFIRST = mFIND

            Do
                Set CpyRng = Union(CpyRng, mFIND)
                Set mFIND = .Range("A1:A54").FindNext(mFIND)
            Loop Until mFIND.Address = mFIRST.Address

            CpyRng.EntireRow.Copy Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
        End If
    End With
End Sub

如果您将“x”单元格移出A列，或者使用弹出框，那么您只需搜索整个A：A列，而不是我指定的短距离。

Answer 2

这是一种极其简单的方式来实现您想要做的事情。它只是向用户显示一个用于输入值的框，并复制该值在A列中的所有行，并将它们放在新工作表上。

Sub CustomCopy()

Dim strsearch As String
Dim lastline As Long, toCopy As Long
Dim searchColumn As String
Dim i As Long, j As Long
Dim c As range

strsearch = CStr(InputBox("Enter the value to search for"))

lastline = range("A" & Rows.Count).End(xlUp).Row
j = 1

For i = 1 To lastline
    If range("A" & i).Value = strsearch Then
       Rows(i).Copy Destination:=Sheets(2).Rows(j)
       j = j + 1
    End If
Next

MsgBox j - 1 & " row(s) copied to Sheet2."

End Sub

使用某些条件复制和粘贴多行

2 个答案: