案例
案例来源：Excel和Access （微信公众号）点击 - 查看原文
示例图一
根据源数据，制作带空行或者不带空行的工资条。
附件：点击查看-百度云
提取密码：uvvo
一、数据源代码
Sub 源数据代码()
'录入数据
Cells(1, 1) = "员工号"
Cells(1, 2) = "姓名"
Cells(1, 3) = "部门"
Cells(1, 4) = "工资"
Cells(1, 5) = "奖金"
Cells(1, 6) = "应发工资"
Cells(2, 1) = "A12"
Cells(2, 2) = "甲"
Cells(2, 3) = "技术部"
Cells(2, 4) = "3600"
Cells(2, 5) = "700"
Cells(2, 6) = "4300"
Cells(3, 1) = "A13"
Cells(3, 2) = "乙"
Cells(3, 3) = "开发部"
Cells(3, 4) = "3100"
Cells(3, 5) = "800"
Cells(3, 6) = "3900"
Cells(4, 1) = "A14"
Cells(4, 2) = "丙"
Cells(4, 3) = "发展部"
Cells(4, 4) = "2900"
Cells(4, 5) = "900"
Cells(4, 6) = "3800"
Cells(5, 1) = "A15"
Cells(5, 2) = "丁"
Cells(5, 3) = "销售部"
Cells(5, 4) = "2200"
Cells(5, 5) = "400"
Cells(5, 6) = "2600"
Cells(6, 1) = "A16"
Cells(6, 2) = "戊"
Cells(6, 3) = "综合部"
Cells(6, 4) = "2900"
Cells(6, 5) = "500"
Cells(6, 6) = "3400"
'格式调整
With Range("a1:f6")
.Borders.LineStyle = 1
.HorizontalAlignment = xlCenter
End With
With Range("a1:f1")
.Font.Bold = True
.Interior.ColorIndex = 15
End With
ActiveWindow.DisplayGridlines = False '设置网格线
End Sub
.Interior.Colorindex = 15 , 表示设置单元格的背景颜色-灰色
二、制作不带空行的工资条
Sub 示例制作不带空行工资条()
Dim I, K, M As Integer
K = InputBox("请输入工资条起始行号，该行号要大于已有工资表数据的行号!", "提示")
If K < Range("a1").End(xlDown).Row Then
MsgBox "您输入的起始行号过少，将会造成错误，请重新输入！", vbCritical, "警告"
Exit Sub
End If
For I = 2 To Range("a1").End(xlDown).Row
Range("a1:f1").Copy Destination:=Range("a" & K + 2 * M)
Range("a" & I & ":f" & I).Copy Destination:=Range("a" & K + 1 + 2 * M)
M = M + 1
Next
'利用m循环增加工资条位置，2*M表示每次循环，工资条向下位移2个位置；3*M表示每次循环，工资条向下位移3个位置，带空行
End Sub
2.1 For循环，利用源数据工资表的最后一行行号
2.2 利用M，做每次工资条位置的变化
三、制作带空行的工资条
Sub 示例制作带空行工资条()
Dim I, K, M As Integer
K = InputBox("请输入工资条起始行号，该行号要大于已有工资表数据的行号!", "提示")
If K < Range("a1").End(xlDown).Row Then
MsgBox "您输入的起始行号过少，将会造成错误，请重新输入！", vbCritical, "警告"
Exit Sub
End If
For I = 2 To Range("a1").End(xlDown).Row
Range("a1:f1").Copy Destination:=Range("a" & K + 3 * M)
Range("a" & I & ":f" & I).Copy Destination:=Range("a" & K + 1 + 3 * M)
M = M + 1
Next
End Sub
- 与不带空行的区别，是在调用m的时候，通过每次增加3行变量，其中带值2行，空1行。
自制工资条代码
Sub 自制工资条()
Dim BiaoTi As Ranges
Dim d As Long
Dim I, x As Integer
'自适应获取excel行数
Range("a1").EntireColumn.Insert shift:=xlShiftToRight
d = Range("a:a").End(xlDown).Row
Range("a1").EntireColumn.Delete shift:=xlShiftToLeft
x = Range("a" & d).End(xlUp).Row
For I = 2 To x
Range("1:1").Copy Range("a" & Range("a" & d).End(xlUp).Row + 2)
Rows(I).Copy Range("a" & Range("a" & d).End(xlUp).Row + 1)
Next
End Sub
自制工资条，通过插入新列-统计表格行数-删除新列，得到一个固定的A列最底的单元格。
工资条是否空行，在第一个复制的地方，.Row+1不空行；.Row+2空行。
