|
|
楼主 |
发表于 2015-7-6 13:02
|
显示全部楼层
Sub 生成有空白行的工资条()
'
' 生成有空白行的工资条
Sheets("工资表").Select ' 选择工资表并复制
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy ' 选择工资表并复制
Sheets("工资条").Select '从A3选择性粘贴工资表
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False '从A3选择性粘贴工资表
Range("A2").Select
Dim i As Integer
Dim endrow As Integer
endrow = Sheet1.Range("a65536").End(xlUp).Row '探测到数据区最后一行
For i = 5 To endrow '插入次数
ActiveCell.Range("A1:AD2").Select '复制带空白行工资条表头
Application.CutCopyMode = False
Selection.Copy '复制带空白行工资条表头
ActiveWindow.LargeScroll ToRight:=-1
ActiveCell.Offset(3, 0).Range("A1").Select
Selection.Insert Shift:=xlDown '隔行插入表头
Next i '插入次数
Dim rng As Range '选择工资条数据区内所有空行
For i = 1 To Range("a65536").End(xlUp).Row + 1
If Cells(i, 1) = 0 And rng Is Nothing Then
Set rng = Cells(i, 1)
ElseIf Cells(i, 1) = 0 Then
Set rng = Union(rng, Cells(i, 1))
End If
Next
rng.EntireRow.Select '选择工资条数据区内所有空行
Selection.RowHeight = 5 '将工资条数据区内所有空行行高调整为5
End Sub |
|
楼主: verywondful
[复制链接]
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2015-7-8 16:47
