|
把sheet2合同模板中黄色区域内容清除
- Sub test()
- Application.DisplayAlerts = False
- Application.ScreenUpdating = False
- Sheets(1).Activate
- n = [A1048576].End(3).Row
- Set d = CreateObject("scripting.dictionary")
- For i = 2 To n
- d(Cells(i, 1).Value) = ""
- Next
- m = d.Count
- For j = 0 To m - 1
- Sheets(2).Copy
- ActiveWorkbook.SaveAs ThisWorkbook.Path & "" & d.keys()(j)
- [M2] = d.keys()(j)
- k = 0
- ThisWorkbook.Activate
- For i = 2 To n
- If Cells(i, 1) = d.keys()(j) Then
-
- Workbooks(d.keys()(j) & ".xlsx").Activate
- Cells(16 + k, 1) = k + 1
- [B16].Offset(k, 0) = ThisWorkbook.Sheets(1).Cells(i, 2)
- [D16].Offset(k, 0) = ThisWorkbook.Sheets(1).Cells(i, 3)
- [E16].Offset(k, 0) = ThisWorkbook.Sheets(1).Cells(i, 4)
- [F16].Offset(k, 0) = ThisWorkbook.Sheets(1).Cells(i, 5)
- [G16].Offset(k, 0) = ThisWorkbook.Sheets(1).Cells(i, 6)
- [I16].Offset(k, 0) = ThisWorkbook.Sheets(1).Cells(i, 7)
- [L16].Offset(k, 0) = ThisWorkbook.Sheets(1).Cells(i, 8)
- [N16].Offset(k, 0) = ThisWorkbook.Sheets(1).Cells(i, 9)
- [O16].Offset(k, 0) = ThisWorkbook.Sheets(1).Cells(i, 10)
- [P16].Offset(k, 0) = ThisWorkbook.Sheets(1).Cells(i, 11)
-
- k = k + 1
- ThisWorkbook.Activate
- End If
- Next
- Workbooks(d.keys()(j) & ".xlsx").Activate
- [A1].Select
- Workbooks(d.keys()(j) & ".xlsx").Close 1
- Next
- Application.DisplayAlerts = True
- Application.ScreenUpdating = True
- End Sub
复制代码 |
|