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

我必须写一个macros来有条件地复制某些行。 如果用户在任何空单元格中input一些数字，比如说A55，那么如果在A1中find该数字，则该数字将与列A（或A1）匹配，那么应该select整行。 如果在列A的多个地方find这个数字，那么它应该复制所有的行并将它们粘贴到新的工作表中，如sheet2。

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

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，或使用了一个popup框，则可以search整个列A：A而不是指定的短范围。

Answer 2

这是一个极其简单的方式来实现你想要做的事情。 它只是向用户显示一个框，用于input一个值，并复制该值在列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