Question

excel表中所有SHEET表中的某一单元格数据提取并生成新的表。

在excel表中有1.xls中有sheet1~sheetn多个表，如何提取每个sheet中（E列：E4~E6000）的数值不等于0的该行组成新的SHEET表
按以下方法，只能取出部分数据，但未能完全取出表中不等于0的数据组成新表，请高手再指点，谢谢！
1 新建一个工作表放在最左边，在这个工作表运行以下代码
Sub 复制()
N = Sheets.Count
For I = 2 To N
For J = 4 To Sheets(I).Range("E60000").End(xlUp).Row
If Sheets(I).Cells(J, 5) <> 0 Then
Sheets(I).Rows(J).Copy Range("A" & Range("A60000").End(xlUp).Row + 1)
End If
Next
Next
End Sub

Answer 1

For I = 2 To N
这条语句有问题，建议遍历工作表，当前表则pass
Sub 复制()
n = "Sheet1" '将新表名称先定死
For i = 1 To Sheets.Count
x = Sheets(i).Name
If x <> n Then
For J = 4 To Sheets(i).Range("E60000").End(xlUp).Row
If Sheets(i).Cells(J, 5) <> 0 Then
Sheets(i).Rows(J).Copy Sheets(n).Range("A" & Sheets(n).Range("E60000").End(xlUp).Row + 1) '''检查E列，加到sheet1表
End If
Next
End If
Next
End Sub

Answer 2

Sub 复制()
N = Sheets.Count
For I = 2 To N
For J = 4 To 6000
If Sheets(I).Cells(J, 5) <> 0 Sheets(I).Rows(J).Copy Destination:=Sheets(1).Rows(Columns(1).Rows.End(xlUp).Row+1)
Next
Next
End Sub
这是在你的程序基础上改的！
如果你把E列按降序排一序的话，可以把循环减少！
Sub 复制()
N = Sheets.Count
For I = 2 To N
do while Sheets(I).Cells(J, 5) =0
Sheets(I).Rows(J).Copy Destination:=Sheets(1).Rows(Columns(1).Rows.End(xlUp).Row+1)
loop
Next
End Sub

Answer 3

按宏来看，没有发现问题，是不是在COPY时，需要加入DoEvents语句，以使sheet1进行更新，以响应你的 END(xlup)操作。我倒觉得，完全可设置一个指针变量，每COPY一行就加1，这样就不需要每次都运算END(xlUp)，不但可加快宏运行速度，可能也避免你的出错的情况，你不如试一下。