筛选表，复制并粘贴到多个现有工作簿中

Question

我有一个表，其中包含多个项目的数据。

我需要过滤数据（按项目编号），然后将每个项目的数据复制并粘贴到单独的现有工作簿中（我有一个选项卡，其中包含每个工作簿的文件路径和项目名称。

我设法打开了第一个项目的工作簿，复制并粘贴，保存并关闭工作簿，但之后excel抛出错误。

我知道有问题，但不太确定如何解决。

有人可以帮忙吗？

下面是文件的链接

enter link description here

Sub OpenProjects()


Dim N As String
Dim LAST As Integer
Dim TABLE As Range
Dim PNumber As String 'Project Number



LAST = Sheets("Projects").Cells(Rows.Count, "A").End(xlUp).Row


Set TABLE = Sheets("Projects").Range("A1:M" & LAST)


'Open files

Sheets("Unique Projects").Select

RowCount = Application.WorksheetFunction.CountA(Sheets("unique Projects").Range("B:B"))


For i = 2 To RowCount

N = Sheets("Unique projects").Cells(i, 2)

Workbooks.Open (N)



    'Back to original workbook



Workbooks("original.xlsm").Activate

For Each NUMBER In Sheets("Unique Projects").Range([A2], Cells(Rows.Count, "A").End(xlUp))

With TABLE
.AutoFilter
.AutoFilter Field:=1, Criteria1:=NUMBER.Value
.SpecialCells(xlCellTypeVisible).Copy Destination:=Workbooks(NUMBER & ".xlsm").Sheets("sheet1").Range("A1")

End With

Workbooks(NUMBER & ".xlsm").Save
Workbooks(NUMBER & ".xlsm").Close

Workbooks("Original").Activate



Next NUMBER


Next i
End Sub