复制整行并将其粘贴到新工作表的下一个空行中

我四处搜寻试图find正确的答案，大部分答案都是为了复制整个范围。

我试图find一个特定的值，复制整行，并将其粘贴到一个新的工作表。 从那里开始，整个过程应该循环，并不断添加每个额外的行到第二个工作表中，而不会覆盖之前input的内容。 目前macros正在覆盖以前find的行。

这是我的代码：

' Search for segment data to add Sub SegSearch() Dim I As Integer Dim Output As Integer Dim KeepRunning As Boolean Dim OtherCondition As String Dim finalval As Long ' Declare Search Variable Dim LSearchRow As Integer Dim LCopyToRow As Integer Dim LSearchValue As String ' Declare Worksheet Variables Dim WSa As Worksheet Dim WSb As Worksheet ' Define WSa/WSb as respective worksheets Set WSa = Sheets("STARS Formatted") Set WSb = Sheets("memo_db") ' Selects "STARS Formatted" sheet for search Sheets("STARS Formatted").Select While KeepRunning = False ' User must enter Segment Value LSearchValue = Application.InputBox("Please enter a Segment to search for.", "Enter Segment") ' User enters null value, exit sub If LSearchValue = "" Then Destroy = True MsgBox ("No Value entered") End If ' User selects "cancel", exit sub If LSearchValue = "False" Then MsgBox ("User Canceled") Exit Sub End If ' ensures if user enters lowercase value will be Uppercase to handle proper search LSearchValue = UCase(LSearchValue) ' Defines first condition to search for in report OtherCondition = "Segment Total" ' determines last row in For Loop finalval = Cells(Rows.Count, "C").End(xlUp).Row For I = 2 To finalval If CStr(Cells(I, 3).Value) = OtherCondition And CStr(Cells(I, 8).Value) = LSearchValue Then ' Start search in row 2 LSearchRow = I ' Start copying data to row 2 in Sheet2 (row counter variable) LCopyToRow = LSearchRow 'Select row in "STARS Fastdata" to copy WSa.Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Copy ' Paste row into memo_db in next row WSb.Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).End(xlUp).Offset(1, 0).PasteSpecial ' Move copy counter to next row LCopyToRow = LCopyToRow + 1 End If Next I Output = MsgBox("Do you want to add another segment?", vbYesNo, "Add Another Segment") If Output = 6 Then KeepRunning = False Else KeepRunning = True End If Wend End Sub 

Answer 1

我会做的是，而不是：

WSb.Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).End(xlUp).Offset(1, 0).PasteSpecial

我会做两个步骤：

 lastrow = WSb.Cells.find("*", [A1], , , xlByRows, xlPrevious).Row 'will give you number of last row WSb.Cells(lastrow+1, 1).pastespecial 

我发现很难确切地知道现有的行上发生了什么，所以find最后一行的数字，然后使用粘贴与WSb.cells（lastrow + 1，1）.pastespecial`，并将粘贴到最后一行之后的行，在第1列中。

你也可以用你自己的方式find最后一排，有人会告诉你我的方式是错的，但是我觉得效果更好。 随你便。