vba - 将多张工作表中的行复制到一张工作表中

Question

Public Sub SubName()
Dim ws As Worksheet
Dim iCounter As Long
Dim wso As Worksheet
Dim rw As Long
Dim lastrow As Long

Set wso = Sheets("Master")

For Each ws In ActiveWorkbook.Worksheets
    If ws.Name Like "*" & "danger" & "*" Then
    ws.Select
    lastrow = ws.Cells(Rows.Count, 4).End(xlUp).Row
            For iCounter = 2 To lastrow
                If ws.Cells(iCounter, 8) < 0.15 And ws.Cells(iCounter, 8) > -0.1 Then

                    ws.Cells(iCounter, 8).EntireRow.Copy

                    rw = wso.Cells(wso.Rows.Count, "A").End(xlUp).Row + 1
                    wso.Cells(rw, 1).PasteSpecial Paste:=xlPasteAll

                End If
            Next iCounter

    End If
Next ws
End Sub

这就是代码的作用:

查看所有工作表，找到带有“危险”文本的工作表

对于名为“danger*”的工作表，遍历 H 列并在满足条件时复制整行

将整行粘贴到主表

我相信代码可以正常工作，直到我需要将其粘贴到主表上。我遇到的问题是它只是粘贴在主工作表上的同一行上，而不是行+1。

最终结果是主工作表上只显示一行，它是要粘贴的迭代中的最后一行。

任何帮助表示赞赏!

Answer 1

试试这个将行从一个工作表复制到另一个工作表(每一行在不同的行上):

Dim i, lastRow as Integer

Dim wso, ws, copyFrom as Worksheet

Set wso = Sheets("Master")

For Each ws In ActiveWorkbook.Worksheets

If ws.Name Like "*" & "danger" & "*" Then

    copyFrom =  ws.Select

End if


lastRow = Sheets(copyFrom).Range("A" & Rows.Count).End(xlUp).Row
For i=1 to lastRow

If <--your criteria--> then

    ThisWorkbook.Sheets(copyFrom).Rows(i).EntireRow.Copy Destination:=ThisWorkbook.Sheets(wso).Rows(i)

End if

Next i
Next ws