复制粘贴按钮代码

SC1300

通过VBA编写复制粘贴的按钮代码如何实现附件功能

hefuqing

1. Sub 保存()
   
2. r2 = Sheets("日记账").[c65530].End(xlUp).Row
   
3. arr = Sheets("日记账").Range("c1:c" & r2)
   
4. Set d = CreateObject("scripting.dictionary")
   
5. For i = 2 To r2
   
6. d(arr(i, 1)) = ""
   
7. Next i
   
8. If d.Exists(Sheets("打印").[I3].Value) Then
   
9. MsgBox "请确认是否重复录入"
   
10. Exit Sub
    
11. End If
    
12. r1 = Sheets("打印").[b13].End(xlUp).Row
    
13. If r1 < 5 Then Exit Sub
    
14. For i = 5 To r1
    
15. r = Sheets("日记账").[c65530].End(xlUp).Row + 1
    
16. Sheets("日记账").Cells(r, 1) = Sheets("打印").[e3]
    
17. Sheets("日记账").Cells(r, 2) = Sheets("打印").[C3]
    
18. Sheets("日记账").Cells(r, 3) = Sheets("打印").[I3]
    
19. Sheets("日记账").Cells(r, 4) = Sheets("打印").Cells(i, 2)
    
20. Sheets("日记账").Cells(r, 5) = Sheets("打印").Cells(i, 3)
    
21. Sheets("日记账").Cells(r, 6) = Sheets("打印").Cells(i, 4)
    
22. Sheets("日记账").Cells(r, 7) = Sheets("打印").Cells(i, 5)
    
23. Sheets("日记账").Cells(r, 8) = Sheets("打印").Cells(i, 6)
    
24. Sheets("日记账").Cells(r, 9) = Sheets("打印").Cells(i, 7)
    
25. Sheets("日记账").Cells(r, 10) = Sheets("打印").Cells(i, 8)
    
26. Sheets("日记账").Cells(r, 11) = Sheets("打印").Cells(i, 9)
    
27. Sheets("日记账").Columns("A:A").NumberFormatLocal = "yyyy/m/d;@"
    
28. Next i
    
29. MsgBox "成功录入" & r - r2 & "条"
    
30. End Sub

复制代码

SC1300

太感谢你了，完美 解决我的问题！