使⽤VBA对指定列进⾏拆分⼯作表并将⼯作表保存为⼯作簿使⽤说明
本⼈为初学者（写的不好轻喷），根据⼤神的写法弄的精简版，中间出现空格可正常统计。
未进⾏序号填充
点击取消会报错
其他BUG后续将会继续完善
Sub 表格关键词拆分()
Application.ScreenUpdating = False
Dim x As Integer, y As Integer, w As Worksheet
inputcol = InputBox("请输⼊拆分列所在序号")
x = 2
y = inputcol
Set w = Worksheets(1)
Do While w.Cells(x, y).Value <> ""
On Error Resume Next
If Worksheets(w.Cells(x, y).Value) Is Nothing Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = w.Cells(x, y).Value
w.Cells(1, 1).Resize(1, 100).Copy Worksheets(w.Cells(x, y).Value).Cells(1, 1)
End If
w.Cells(x, 1).Resize(1, 100).Copy Worksheets(w.Cells(x, y).Value).Range("A60000").End(xlUp).Offset(1, 0)
x = x + 1
Loop
Dim folder As String
folder = ThisWorkbook.Path & "拆分⼯作表"
resize函数vbaIf Len(Dir(folder, vbDirectory)) = 0 Then MkDir folder
Dim i As Integer, sht As Worksheet
For i = 2 To Sheets.Count
Sheets(i).Copy
ActiveWorkbook.SaveAs folder & "\" & Sheets(1).Name & ".xls"
ActiveWorkbook.Close
Next
End Sub

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。