自动复制按钮

zkonghui2010

老师好，我现在需要将技术一到智能七个表格中的数据自动复制到表格汇总中，如果表格汇总中已经有技术一到智能的数据不需要重新复制

liujialin0o0

同一个sheet表里有相同的数据,感觉表模拟有问题,日期,生产编号都一样的

zkonghui2010

liujialin0o0 发表于 2018-8-17 10:26
同一个sheet表里有相同的数据,感觉表模拟有问题,日期,生产编号都一样的

数据是有问题，重新修改上传谢谢

zkonghui2010

数据表有问题，重新复制上传

xiangbaoan

……自行测试行不行，表中大量无内容但有格式的单元格已处理了……

liujialin0o0

公司网络传不了附件,写得不好,请测试

1. Sub hb()
   
2. Dim sh As Worksheet, i%, n%, k%, z%, x%, y%
   
3. Application.ScreenUpdating = False
   
4. 
   
5. For Each sh In Sheets
   
6.     sh.Activate
   
7.     n = Cells(Rows.Count, 1).End(3).Row
   
8.     For i = 2 To n
   
9.         Cells(i, 15) = Cells(i, 1) & Cells(i, 2) & Cells(i, 3) & Cells(i, 4)
   
10.     Next
    
11. Next
    
12. 
    
13. x = Worksheets.Count - 1
    
14. 
    
15. If Sheets(Worksheets.Count).Cells(2, 15) = "" Then
    
16.     Set Rng = Sheets(Worksheets.Count).Cells(2, 15)
    
17. Else
    
18.     Set Rng = Sheets(Worksheets.Count).Range(Cells(2, 15), Cells(Rows.Count, 15))
    
19. End If
    
20.    
    
21. For y = 1 To x
    
22.     Sheets(y).Activate
    
23.     n = Cells(Rows.Count, 1).End(3).Row
    
24.     For k = 2 To n
    
25.         Sheets(y).Activate
    
26.         If Rng.Find(Cells(k, 15)) Is Nothing Then
    
27.             Range(Cells(k, 1), Cells(k, 13)).Copy
    
28.             Sheets(Worksheets.Count).Activate
    
29.             z = Cells(Rows.Count, 1).End(3).Row
    
30.             Cells(z, 1).Offset(1, 0).Select
    
31.             Sheets(Worksheets.Count).Paste
    
32.         End If
    
33.     Next
    
34. Next
    
35. 
    
36. For y = 1 To x + 1
    
37.     Sheets(y).Activate
    
38.     Range(Cells(2, 15), Cells(Rows.Count, 15).End(3)).Clear
    
39.     [A1].Select
    
40. Next
    
41. 
    
42. MsgBox "汇总完成!"
    
43. Application.ScreenUpdating = True
    
44. 
    
45. End Sub
    

复制代码

zkonghui2010

xiangbaoan 发表于 2018-8-17 11:46
……自行测试行不行，表中大量无内容但有格式的单元格已处理了……

非常感谢，