У Дэвида есть несколько рабочих тетрадей, в каждой из которых есть по несколько рабочих листов. Он хотел бы объединить определенный рабочий лист (только один) из каждой из этих книг в новую рабочую книгу. Он знает, как сделать это вручную, используя перемещение или копирование листа, но ему нужен способ сделать это более автоматически, особенно потому, что может быть много книг, которые ему нужно «объединить» таким образом.

Есть несколько различных способов решения этой проблемы, и все они включают использование макросов. (Это не должно вызывать удивления — макросы предназначены для быстрой работы с утомительными ручными задачами.)

Следующий макрос прост по конструкции; он перебирает все открытые в данный момент книги и для каждой книги (за исключением книги, содержащей макрос) копирует лист с именем «Sheet1» из этой книги в книгу, содержащую код.

Sub CopySheets1()

Dim wkb As Workbook     Dim sWksName As String

sWksName = "Sheet1"

For Each wkb In Workbooks         If wkb.Name <> ThisWorkbook.Name Then             wkb.Worksheets(sWksName).Copy _               Before:=ThisWorkbook.Sheets(1)

End If     Next     Set wkb = Nothing End 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 = Nothing End Sub

Возможно, самым большим недостатком подходов к настоящему времени является то, что все книги должны быть открытыми. Это не всегда возможно. Например, у вас может быть сотня разных книг в папке, и вам нужно объединить лист каждой из них. Хотя открытие сотни рабочих тетрадей технически возможно, для большинства людей это, вероятно, непрактично. В этом случае вам нужно использовать другой подход.

Следующий макрос CombineSheets является интерактивным по своей природе. Он запрашивает у вас несколько частей информации, а затем добавляет рабочие листы в книгу на основе ваших ответов. Сначала он запрашивает путь к рабочим листам (не включая косую черту в конце), а затем шаблон для использования в рабочих книгах. Вы можете указать шаблон книги с помощью обычных подстановочных знаков звездочки () и вопросительного знака (?). Например, шаблон будет соответствовать всем книгам, а шаблон Budget20 ??

вернет только книги, в начале которых есть «Budget20» и любые два символа после него.

Sub CombineSheets()

Dim sPath As String     Dim sFname As String     Dim wBk As Workbook     Dim wSht As Variant

Application.EnableEvents = False     Application.ScreenUpdating = False     sPath = InputBox("Enter a full path to workbooks")

ChDir sPath     sFname = InputBox("Enter a filename pattern")

sFname = Dir(sPath & "\" & sFname & ".xl*", vbNormal)

wSht = InputBox("Enter a worksheet name to copy")

Do Until sFname = ""

Set 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 = True End Sub

Когда вы запускаете макрос, вас также просят указать имя листа для копирования из каждой подходящей книги. Укажите имя, и, если такой лист существует в книге, он копируется в начало текущей книги.

Если вы предпочитаете не создавать свой собственный макрос для объединения листов, вы можете рассмотреть надстройку RDBMerge, созданную MVP Excel Рон де Брюин.

Вы можете найти его бесплатно здесь:

http://www.rondebruin.nl/win/addins/rdbmerge.htm

_Примечание: _

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

link: / excelribbon-ExcelTipsMacros [Щелкните здесь, чтобы открыть эту специальную страницу в новой вкладке браузера].

ExcelTips — ваш источник экономичного обучения Microsoft Excel.

Этот совет (7425) применим к Microsoft Excel 97, 2000, 2002 и 2003.