Question

我使用以下代码将某些行复制并粘贴到新工作簿中：

Sub ReportCreator()

    Dim wbI As Workbook, wbO As Workbook
    Dim wsI As Worksheet, wsO As Worksheet
    Dim iCounter As Long
    Dim lrow As Long


    '~~> Source/Input Workbook
    Set wbI = ThisWorkbook
    '~~> Set the relevant sheet from where you want to copy
    Set wsI = wbI.Sheets("Pharmas")

    '~~> Destination/Output Workbook
    Set wbO = Workbooks.Add

lastRow = ThisWorkbook.Worksheets("Pharmas").Cells(Rows.Count, "L").End(xlUp).Row


    With wbO
        '~~> Set the relevant sheet to where you want to paste
        Set wsO = wbO.Sheets("Sheet1")

        '~~>. Save the file

        For iCounter = 2 To lastRow
        If wsI.Cells(iCounter, 4) = "Barr" Then
        wsI.Rows(iCounter).Copy
        End If

        wsO.Range("A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

        Next iCounter

.SaveAs Filename:="C:\Users\rrrrr\Desktop\eeee.xls", FileFormat:=56
       End With




End Sub

当代码列在我的列表中时，第4列中Barr的任何行都会被复制，然后粘贴到新工作簿上。

我遇到的问题是它没有为它找到的每一行粘贴新工作簿。而不是在新工作簿上，它只是用更新的信息覆盖第一行。当我调试时，寻找Barr并复制该行的代码部分正在运行，但它没有粘贴到工作簿上，它只是覆盖了第一行。

我尝试添加更改粘贴代码，如下所示：

wsI.Rows(iCounter).Copy
            End If
lrow = Range("A" & .Rows.Count).End(xlUp).Row
            wsO.Range("A" & lrow + 1).PasteSpecial Paste:=xlPasteValues,

但是，它告诉我 Object不支持此属性或方法。

我确定粘贴代码不正确，但我不确定如何更改它以便填写工作簿，而不是一遍又一遍地覆盖第一个条目以及Barr的每个后续查找。

Answer 1

在您的解决方案中，您忘记引用wsO：

lrow = wsO.Range("A" & wsO.Rows.Count).End(xlUp).Row
wsO.Range("A" & lrow + 1).PasteSpecial Paste:=xlPasteValues

此解决方案应该可行，但应该很慢。通过跟踪变量中的下一行并在粘贴行时对其进行icrement，可以更快地运行。

Answer 2

如果您想要的只是值，则不要使用粘贴，而是直接将值分配给单元格。

lrow = wsO.Range("A" & wsO.Rows.Count).End(xlUp).Row
wsO.rows(lrow + 1).value =wsI.Rows(iCounter).value

填写工作簿，而不是一遍又一遍地覆盖第一个条目

2 个答案: