|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
参与一下。。。
- 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
复制代码
|
评分
-
3
查看全部评分
-
|