使用VBA在Excel中将主工作簿拆分为多个工作簿



我从YouTube教程中得到了这段代码(https://www.youtube.com/watch?v=5bOFNsdHiPk&t=326s(。

Sub SplitandFilterSheet()
'Step 1 - Name your ranges and Copy sheet
'Step 2 - Filter by Department and delete rows not applicable
'Step 3 - Loop until the end of the list
Dim Splitcode As Range
Sheets("Master").Select
Set Splitcode = Range("Splitcode")

For Each cell In Splitcode
Sheets("Master").Copy After:=Worksheets(Sheets.Count)
ActiveSheet.Name = cell.Value

With ActiveWorkbook.Sheets(cell.Value).Range("MasterData")
.AutoFilter Field:=4, Criteria1:="<>" & cell.Value, Operator:=xlFilterValues
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With

ActiveSheet.AutoFilter.ShowAllData
Next cell
End Sub

我收到错误

该名称已被使用。试试另一个。

在上

ActiveSheet.Name = cell.Value

它似乎复制了";"大师";而不是经历过滤/复制过程的其余部分,因为它生成Master(2(&每次我跑步时,主(3(表。

您的错误消息是因为代码试图使用已存在的名称重命名工作表。您的代码几乎是一个";运行一次";方法

您可以通过首先删除任何现有图纸来处理该错误。

Sub SplitandFilterSheet()
Dim Splitcode As Range, wb As Workbook, cell As Range, nm As String
Dim wsMaster As Worksheet
Set wb = ActiveWorkbook
Set wsMaster = wb.Sheets("Master")
Set Splitcode = wsMaster.Range("Splitcode")

For Each cell In Splitcode.Cells
nm = cell.Value
On Error Resume Next   'ignore error if no sheet with this name
wb.Sheets(nm).Delete   'delete any existing sheet with this name
On Error Goto 0        'stop ignoring errors
wsMaster.Copy After:=wb.Worksheets(wb.Sheets.Count)
With wb.Worksheets(wb.Sheets.Count)
.Name = nm
With .Range("MasterData")
.AutoFilter Field:=4, Criteria1:="<>" & nm, Operator:=xlFilterValues
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
.AutoFilter.ShowAllData
End with
Next cell
End Sub

最新更新