У Дэвида есть несколько рабочих книг, в каждой из которых есть несколько рабочих листов. Он хотел бы объединить определенный рабочий лист (только один) из каждой из этих книг в новую рабочую книгу. Он знает, как сделать это вручную, используя перемещение или копирование листа, но ему нужен способ сделать это более автоматически, особенно потому, что может быть много книг, которые ему нужно «объединить» таким образом.
Есть несколько различных способов решения этой проблемы, и все они включают использование макросов. (Это не должно вызывать удивления – макросы предназначены для быстрой работы с утомительными ручными задачами.)
Следующий макрос прост по конструкции; он перебирает все открытые в данный момент книги и для каждой книги (кроме книги, содержащей макрос) копирует лист с именем «Sheet1» из этой книги в книгу, содержащую код.
Sub CopySheets1 ( ) Dim wkb As Workbook Dim sWksName As String sWksName = «Sheet1» Для каждого wkb в рабочих книгах Если wkb.Name ThisWorkbook.Name Then wkb.Worksheets (sWksName) .Copy _ Before: = ThisWorkbook.Sheets (1) End If Next Установите wkb = NothingEnd Sub
Если вы хотите, чтобы макрос захватил рабочий лист, отличный от Sheet1, просто измените значение переменной sWksName, чтобы отразить желаемое имя рабочего листа. Если вы не знаете, какое будет имя рабочего листа, но знаете, что копируемый рабочий лист всегда будет вторым рабочим листом в каждой книге, вы можете использовать этот вариант макроса:
Sub CopySheets2 () Dim wkb As Workbook Dim sWksName As String For each wkb In Workbooks If wkb.Name ThisWorkbook.Name Then wkb.Worksheets (2) .Copy _ Before: = ThisWorkbook.Sheets (1) End If Next Set wkb = NothingEnd Sub
Возможно, самый большой недостаток подходов до сих пор заключается в том, что все книги должны быть открыты. Это не всегда возможно. Например, у вас может быть сотня разных книг в папке, и вам нужно объединить рабочий лист из каждой из них. Хотя открытие сотни рабочих тетрадей технически возможно, для большинства людей это, вероятно, непрактично. В этом случае вам нужно использовать другой подход.
Следующий макрос CombineSheets является интерактивным по своей природе. Он запрашивает у вас несколько единиц информации, а затем добавляет рабочие листы в книгу на основе ваших ответов. Сначала он запрашивает путь к рабочим листам (не включая косую черту в конце), а затем шаблон, который будет использоваться для рабочих книг. Вы можете указать шаблон книги с помощью обычных подстановочных знаков звездочки (*) и вопросительного знака (?). Например, шаблон * будет соответствовать всем книгам, а шаблон Budget20 ?? вернет только книги, у которых есть «Budget20» в начале и любые два символа после этого.
Sub CombineSheets () Dim sPath As String Dim sFname As String Dim wBk As Workbook Dim wSht As Variant Application. EnableEvents = Ложное приложение. ScreenUpdating = False sPath = InputBox («Введите полный путь к книгам») ChDir sPath sFname = InputBox («Введите шаблон имени файла») sFname = Dir (sPath & «» & sFname & «.xl *», vbNormal) wSht = InputBox («Введите имя рабочего листа для копирования») Выполнить до sFname = «» Установить wBk = Workbooks.Open (sFname) Windows (sFname) .Activate Sheets (wSht) .Copy Before: = ThisWorkbook.Sheets (1) wBk. Close False sFname = Dir () Loop ActiveWorkbook.Save Application.EnableEvents = True Application.ScreenUpdating = TrueEnd Sub
Когда вы запускаете макрос, вас также спрашивают имя рабочего листа для копирования из каждого соответствующая рабочая книга. Введите имя, и если такой лист существует в книге, он копируется в начало текущей книги.
Если вы предпочитаете не создавать свой собственный макрос для объединения листов, вы можете рассмотреть Надстройка RDBMerge, созданная специалистом по Excel Рон де Брюин. Вы можете найти его бесплатно здесь:
http://www.rondebruin.nl/win/addins/rdbmerge.htm
Источник: