Question

我一直在寻找正确的答案，大多数答案都是为了复制整个范围。

我正在尝试查找特定值，复制整行，然后将其粘贴到新工作表中。从那里开始，整个过程应循环并继续将每个附加行添加到第二个工作表中，而不会覆盖先前输入的内容。目前，宏正在覆盖以前找到的行。

这是我的代码：

' 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

我发现很难确切地告诉现有行发生了什么，所以找到最后一行的数字，然后使用只有WSb.cells的粘贴（lastrow + 1,1）.pastespecial`和那个' ll将粘贴到第1列的最后一行之后的行中。

你也可以用你自己的方式找到最后一排，有些人会告诉你我的方式是错的，但我发现它的效果更好。由你决定。

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

1 个答案: