Вопрос № 108049: Уважаемые эксперты!
Помогите решить проблему:
В n ячейках Лист1 Книги1 (Excel) записаны n чисел (напр. 4) из 20. В закрытой книге 2 находятся 20 листов (заданий): Лист1, Лист2, … и т.д. Как скопировать эти n листов из Книги2 с номерами, соот...
Вопрос № 108.049
Уважаемые эксперты!
Помогите решить проблему:
В n ячейках Лист1 Книги1 (Excel) записаны n чисел (напр. 4) из 20. В закрытой книге 2 находятся 20 листов (заданий): Лист1, Лист2, … и т.д. Как скопировать эти n листов из Книги2 с номерами, соответствующим записанным числам в Книгу1.
Благодарю покорнейше!
Отвечает: Тесленко Евгений Алексеевич
Здравствуйте, Зыков Феликс Никанорович!
пример сбора данных со всех листов книги в приложении.
Надстройка "Колонка из другой таблицы" по адресу :http://ifolder.ru/3765138
Используя два этих "инструмента" Вы сможете решить эту задачу.
Евгений.
Отвечает: HookEst
Здравствуйте, Зыков Феликс Никанорович!
Предлагаю свой вариант.
Диапазон номеров shNames(также могут быть и имена листов, не только номера) может быть задан константно для каждой персоны(e.x. Const Person1="B4:B7") тогда строку
Set shNames = Selection надо заменить на Set shNames = Range(Person1) для каждого, но я использовал свойство Selection. Этот макрос копирует из книги SRC_BOOK в активную книгу, листы с номерами/именами, содержащимися в выделеном диапазоне. (выделяете B4:B7 и запускаете макрос CopySheets)
так много переменных пришлось вводить из-за того, что открытие SRC_BOOK изменяет ActiveBook и Selection, приходится сохранять их в переменные(shNames и dstBook)
Option Explicit
Const SRC_BOOK = "d:source.xls" 'путь ко второй закрытой книге
Sub CopySheets()
Dim c As Range 'ячейка с номером листа
Dim shNames As Range 'диапазон с номерами листов, для конкретной персоны
Dim dstBook As Workbook 'книга куда копировать
Dim srcBook As Workbook 'книга откуда копировать
Dim srcSheet As Worksheet 'копируемый лист
On Error Resume Next 'обработку ошибок можно и усложнить
Set shNames = Selection
Set dstBook = ActiveWorkbook
Set srcBook = Workbooks.Add(SRC_BOOK) 'открываем
For Each c In shNames
Set srcSheet = srcBook.Worksheets(c)
If Not srcSheet Is Nothing Then
With dstBook
srcSheet.Copy after:=.Worksheets(.Worksheets.Count) 'копируем в конец
End With
Set srcSheet = Nothing
End If
Next c
srcBook.Close False 'закрываем
shNames.Select
End Sub
Успехов.
Ответ отправил: HookEst (статус: Студент)
Ответ отправлен: 06.11.2007, 05:51 Оценка за ответ: 5
