|
- Sub test()
- Dim r%, i%
- Dim arr, brr
- Dim rng As Range
- Dim ws As Worksheet
- Dim hg(1 To 4) As Double
- Dim lk() As Double
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- Set ws = Worksheets("工资条")
- With ws
- .Cells.Clear
- End With
- With Worksheets("工资总表")
- r = .Cells(.Rows.Count, 2).End(xlUp).Row
- c = .Cells(3, .Columns.Count).End(xlToLeft).Column
- For i = 3 To 6
- hg(i - 2) = .Rows(i).RowHeight
- Next
- ReDim lk(1 To c)
- For j = 1 To c
- lk(j) = .Columns(j).ColumnWidth
- Next
- m = 1
- For i = 6 To r
- .Range("a3:ad5").Copy ws.Cells(m, 1) ‘这里是调整表头的,你看看你的表头到哪个单元格,ad5改成就行了
- .Cells(i, 1).Resize(1, 30).Copy ws.Cells(m + 3, 1) ’这里头Resize(1, 30),30是管着你下边复制多宽的,列多了你就数数多少改大点
- For k = 1 To 4
- ws.Rows(m + k - 1).RowHeight = hg(k)
- Next
- ws.Rows(m + 4).Resize(2, 1).RowHeight = 4.5
- With ws.Cells(m + 5, 1).Resize(1, 30).Borders(xlEdgeTop)
- .LineStyle = xlContinuous
- .Weight = xlHairline
- End With
- m = m + 6
- Next
- For j = 1 To UBound(lk)
- ws.Columns(j).ColumnWidth = lk(j)
- Next
- End With
- End Sub
复制代码
我是菜鸟,不会写,凑合能改改
|
|