[已解决]在线求助！！急！急！ 改代码

文轩馨婷

原代码如下——如何更改为：1.从各表复制到总表（即当前表）的第一列为文本格式（因为其它各表第一列是公式——即附件图片的“部门”列）；2.当各表需引用的数据为空白时（空白处有存在公式）不复制到汇总表！
不知有没有说清楚！{:251:}


现已增加附件（最终效果图也在附件）


Sub 汇总各表数据()
Dim N As Integer, M As Integer, A As Integer

For N = 1 To 7       '要合并的工作表编号

    M = Sheets(N).[A65536].End(xlUp).Row   'A列的最后一个单元格所在的行号

    b = [A65536].End(xlUp).Row + 1    '目标位置空1行

    Sheets(N).Rows(2 & ":" & M).Copy    ' 从第2行开始复制各表数据到新工作台表中

    Cells(b, 1).Select

    ActiveSheet.Paste

    Next N

End Sub

最佳答案

月排行榜 / 总排行榜

grf1973

2014-5-7 12:13

主要是用End(xlup)取最大行时，只要有公式，系统就认为是非空单元格。所以代码中加了6--8句，把A列有公式但无数值的行去掉。请看附件。

跳转到最佳答案楼层

我心飞翔410

最好来个附件

文轩馨婷

我心飞翔410 发表于 2014-5-7 11:00
最好来个附件

老师，增加附件了！

劳烦帮忙看看！

先谢过了！

grf1973

只复制数值不好吗？

1. Sub 汇总各表数据()
   
2. Dim N As Integer, M As Integer, A As Integer
   
3. For N = 1 To 7       '要合并的工作表编号
   
4.     M = Sheets(N).[A65536].End(xlUp).Row   'A列的最后一个单元格所在的行号
   
5.     b = [A65536].End(xlUp).Row + 1    '目标位置空1行
   
6.     ActiveSheet.Rows(b & ":" & (b + M - 2)).Value = Sheets(N).Rows(2 & ":" & M).Value    ' 从第2行开始复制各表数据到新工作台表中
   
7. Next N

复制代码

文轩馨婷

grf1973 发表于 2014-5-7 11:25
只复制数值不好吗？

不行！

在其它表中有合并单元格项！

grf1973

或者原代码直接改成Cells(b,1).PasteSpecial Paste:=xlPasteValues

grf1973

我试了下可以的呀。

文轩馨婷

grf1973 发表于 2014-5-7 11:30
或者原代码直接改成Cells(b,1).PasteSpecial Paste:=xlPasteValues

老师，
  还是不行，虽合并单元格项存在，但第一列依然有公式而且中间有很多空白单元格项（如附件图）

grf1973

1. Sub 汇总各表数据()
   
2. Dim N As Integer, M As Integer, A As Integer
   
3. Rows("2:65536").Delete
   
4. For N = 1 To 7       '要合并的工作表编号
   
5. 
   
6.     M = Sheets(N).[A65536].End(xlUp).Row   'A列的最后一个单元格所在的行号
   
7. 
   
8.     b = [A65536].End(xlUp).Row + 1    '目标位置空1行
   
9. 
   
10.     Sheets(N).Rows(2 & ":" & M).Copy    ' 从第2行开始复制各表数据到新工作台表中
    
11. 
    
12.     Cells(b, 1).PasteSpecial Paste:=xlPasteValues
    
13.     Cells(b, 1).PasteSpecial Paste:=xlPasteFormats
    
14.     Next N
    
15. 
    
16. End Sub

复制代码

这样可以了，不过最后要加一段删除空行的语句。

文轩馨婷

grf1973 发表于 2014-5-7 11:36
我试了下可以的呀。

可能是我表述的不太清楚

其实我想要的就如附件效果