VBA批量生成工资条（每页打印20位员工工资条）

蜂蜜xiao柚子

sunya_0529 发表于 2015-1-27 00:08
http://club.excelhome.net/forum.php?mod=redirect&goto=findpost&ptid=633550&pid=4299334

试试上面 ...

看不明白！还请老师帮忙解决！

sunya_0529

蜂蜜xiao柚子 发表于 2015-1-27 11:07
看不明白！还请老师帮忙解决！

1. Option Explicit
   
2. 
   
3. Sub CreatePaySlip()
   
4. On Error Resume Next
   
5. Dim k As Range, intRow%
   
6. Set k = Application.InputBox("Please select the range of title:", "Selection", Type:=8)
   
7. If k Is Nothing Then Exit Sub
   
8. If MsgBox("Do you need insert a blank row between every record?", vbYesNo, "Attention") = vbYes Then
   
9.   k.Cells(1).EntireRow.Insert shift:=xlDown
   
10.   Set k = k.Offset(-1, 0).EntireRow.Resize(k.Rows.Count + 1)
    
11. End If
    
12. intRow = 1
    
13. Application.ScreenUpdating = False
    
14. With ActiveSheet
    
15.   Do
    
16.     k.EntireRow.Copy
    
17.     .Rows(intRow * (k.Rows.Count + 1) + k.Cells(1).Row).Insert shift:=xlDown
    
18.     intRow = intRow + 1
    
19.   Loop While .Cells(intRow * (k.Rows.Count + 1) + k.Cells(1).Row, k.Column) <> ""
    
20. End With
    
21. Application.CutCopyMode = False
    
22. Application.ScreenUpdating = True
    
23. Set k = Nothing
    
24. End Sub

复制代码

蜂蜜xiao柚子

sunya_0529 发表于 2015-1-29 21:26

非常谢谢!
虽然代码看不懂，但是问题得到解决，后面慢慢摸索！

微笑的泥娃娃

好多我们都要一行一行的去复制粘贴的，在这里都有快速便捷的方法

天生懒美人

正好我也想学习下这个技能，先评论后面再找时间练习

exmir2

这功能好强大，能不能在新的工作表生产呢