将多个工作表的行复制到一个工作表中

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 

这是代码的作用：

1. 查看所有表单，查找带有“危险”文字的表单
2. 使用名为“危险*”的工作表时，如果满足条件，则通过H列并复制整行
3. 将整行粘贴到主表单上

我相信代码工作正常，直到我需要它粘贴到主表。 我得到的问题是，它只是粘贴在主表上的同一行，而不是去行+ 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