|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Sub 按B列字段拆分到新建工作簿()
- Sheets("1989-007").Activate
- Dim wb As Workbook, rng As Range, arr, ar, s$, i&
- arr = Range("D1", [a65536].End(3)).Value
- For i = 3 To UBound(arr)
- If InStr(arr(i, 2), "新闻串联单") > 0 Then
- Set rng = Range("A1:D2")
- s = Trim(arr(i, 2))
- ar = Range(Cells(i, 2), Cells(i, 2).End(4)).Value
- Set rng = Union(rng, Cells(i, 1).Resize(UBound(ar), 4))
- Set wb = Workbooks.Add
- With wb.Sheets(1)
- rng.Copy .Range("A1")
- End With
- wb.SaveAs Filename:=ThisWorkbook.Path & "" & s
- wb.Close
- i = i + UBound(ar) + 1
- End If
- Next
- End Sub
复制代码 |
|