Фильтровать таблицу, копировать и вставлять в несколько существующих книг - PullRequest
0 голосов
/ 07 марта 2019

У меня есть таблица с данными для нескольких проектов.

Мне нужно отфильтровать данные (по номеру проекта), затем скопировать и вставить данные каждого проекта в отдельные существующие рабочие книги (у меня есть вкладка, которая содержит пути к файлам каждой рабочей книги и имена проектов.

Мне удалось открыть рабочую книгу первого проекта, скопировать и вставить, сохранить и закрыть рабочую книгу, но после этого Excel выдает ошибку.

Я знаю, что есть проблема, но не уверен, как ее исправить.

Может кто-нибудь помочь?

Ниже приведена ссылка на файлы

введите описание ссылки здесь

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...