参与一下。。。
- Sub ykcbf() '//2024.12.5
- Application.ScreenUpdating = False
- arr = Sheets("Consolidated Data").UsedRange
- Set sh = ThisWorkbook.Sheets("无就业意愿人员情况登记表")
- sh.UsedRange.Clear
- Sheets("模板").Cells.Copy sh.[a1]
- Set Rng = Sheets("模板").Rows("1:10")
- With sh
- For i = 2 To UBound(arr)
- If arr(i, 1) <> Empty Then
- m = m + 1
- r = 10 * (m - 1) + 1
- Rng.Copy .Cells(r, 1)
- .Cells(r, 1) = "无就业意愿人员情况登记表(" & m & ")"
- .Cells(r + 1, 2) = arr(i, 1)
- .Cells(r + 1, 4) = arr(i, 2)
- .Cells(r + 1, 6) = arr(i, 3)
- .Cells(r + 1, 8) = arr(i, 4)
- .Cells(r + 2, 2) = arr(i, 5)
- .Cells(r + 2, 6) = arr(i, 6)
- .Cells(r + 2, 8) = arr(i, 7)
- .Cells(r + 3, 2) = arr(i, 8)
- .Cells(r + 3, 4) = arr(i, 9)
- .Cells(r + 3, 6) = arr(i, 10)
- .Cells(r + 3, 8) = arr(i, 11)
- .Cells(r + 4, 2) = arr(i, 12)
- .Cells(r + 4, 6) = arr(i, 13)
- .Cells(r + 5, 2) = arr(i, 14)
- .Cells(r + 6, 2) = arr(i, 15)
- .Cells(r + 7, 2) = arr(i, 16)
- End If
- Next
- End With
- Application.ScreenUpdating = True
- MsgBox "OK！"
- End Sub
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-12-5 17:37
楼主
