Экспорт из Excel в Excel VBA

Обновлено: 06.07.2024

На этой странице вы найдете базовый код VBA для импорта и экспорта кода VBA в Excel для Windows.
Вы можете использовать его для импорта модулей/пользовательских форм в другие файлы Excel или для обновления кода в других файлах Excel.
Примечание. В этом примере код не экспортируется/импортируется из модулей листа и из модуля Thisworkbook.

Совет. Ознакомьтесь также с двумя ссылками в разделе "Дополнительная информация" на этой странице.

Макрос экспорта экспортирует каждый модуль (.bas), модуль класса (.cls) и пользовательскую форму (.frm, .frx) из ActiveWorkbook в папку с именем «VBAProjectFiles» в папке «Документы».
Примечание. : никогда не переименовывайте эти файлы вручную, потому что имя файла не совпадает с именем модуля, которое вы
увидите после импорта кода в другую книгу Excel.

Если вы откроете, например, файл модуля (.bas) в Блокноте, вы увидите эту строку метаданных вверху
Атрибут VB_Name = "TheNameYouWant"
Это имя, которое модуль имеет, когда вы импортировать его в другую книгу.

Если вы отредактируете имя модуля в свойствах модуля, эта строка будет красиво обновлена. Поэтому, если вы видите неправильные имена после экспорта, сначала проверьте эту строку метаданных. Если эта строка отсутствует, будут использоваться модули по умолчанию Module1, Module2, .

Как это работает?

1: Откройте файл с кодом с этой страницы
2: Откройте/активируйте файл с модулями, которые вы хотите экспортировать
3: Запустите макрос ExportModules
4: Примечание: Если вы посмотрите в папку VBAProjectFiles, вы увидите файлы сейчас
5: Откройте/активируйте книгу, в которую вы хотите добавить модули
6: Запустите макрос ImportModules (он удалит все существующие модули/пользовательские формы из сначала эту книгу)
7: Готово

Код VBA

Скопируйте каждый макрос и функцию ниже в стандартный модуль новой книги и сохраните этот файл импорта-экспорта как xls или xlsm.

В редакторе VBE установите ссылку на "Microsoft Visual Basic For Applications Extensibility 5.3" и на "Microsoft Scripting Runtime", а затем сохраните файл.

Вам также необходимо включить программный доступ к проекту VBA в Excel. В Excel 2003 и более ранних версиях выберите Инструменты > Макросы > Безопасность (в Excel), щелкните вкладку Надежные издатели и установите флажок Доверять доступ к параметру проекта Visual Basic. В Excel 2007–2013 перейдите на вкладку «Разработчик», а затем щелкните элемент «Безопасность макросов». В этом диалоговом окне выберите «Параметры макроса» и установите флажок «Доверять доступу к объектной модели проекта VBA». Вы также можете попробовать сочетание клавиш ALT tms, чтобы перейти к этому диалоговому окну.

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

Копировать макросы из другой книги

Макросы, которые вы создаете в Excel, хранятся в модулях, и вы можете копировать эти модули в другие книги.

Откройте как файл с сохраненным макросом, так и тот, в котором вы хотите его сохранить.
Перейдите на вкладку "Разработчик" в любом файле.
Нажмите кнопку Visual Basic.

В окне VBA на левой панели отображается представление Project Explorer. Это показывает все открытые книги и модули, содержащие макросы для каждого файла.

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

Модуль копируется в файл.

Проверить скопированный макрос

Как и при создании макроса, важно протестировать макрос, который вы скопировали в другую книгу. Если вы случайно скопировали не тот, вам нужно немедленно исправить ошибку.

Выберите лист, на котором вы хотите запустить только что скопированный макрос.
Нажмите кнопку "Макросы" на вкладке "Разработчик".

В диалоговом окне "Макрос" убедитесь, что в меню "Макросы" выбран параметр "Эта книга".Это лучший способ убедиться, что макрос был скопирован непосредственно в активную книгу.

Макрос, который вы скопировали в файл, должен появиться в списке макросов для этой книги.

БЕСПЛАТНЫЙ краткий справочник

Бесплатно для распространения с нашей благодарностью; мы надеемся, что вы рассмотрите наше платное обучение.

Что-то, что снова и снова возникает в любой работе, — это разделение данных по отдельным книгам на основе значений поля в данных.

Допустим, у вас есть данные о продажах вашей компании, и вам нужно отправить каждому торговому представителю компании копию их продаж.

Возможно, вы не захотите предоставлять каждому представителю весь набор данных, а только их собственные продажи из-за соображений конфиденциальности, связанных с их комиссионным вознаграждением.

Для этого вам потребуется взять наш исходный набор данных и разбить его на несколько разных рабочих книг (по одной для каждого торгового представителя) на основе столбца торговых представителей в данных.

Синтаксический анализ и экспорт данных в разные рабочие книги — очень распространенная проблема. К сожалению, в Excel нет встроенного решения.

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

К счастью, мы можем автоматизировать это с помощью VBA!

Этот шаблон позволит вам разделить данные, выбрав столбец, на основе которого они будут разделены.

В этой книге для хранения сводных данных используется таблица Data. Вы можете настроить размер и заголовок столбца в соответствии с вашими данными. Удалите или добавьте столбцы по желанию и переименуйте заголовки столбцов в соответствии с вашими данными.

Раскрывающееся меню автоматически учитывает новые заголовки столбцов. Задайте соответствующий путь для сохранения, именно здесь VBA будет сохранять все новые файлы данных, которые он создает.

Когда шаблон настроен, нажмите кнопку "Выполнить", и ваши новые файлы данных появятся в папке пути для сохранения.

VBA использует ссылки на именованные диапазоны, поэтому шаблон является гибким, и вы можете вырезать и вставлять лист, пока не будете удовлетворены, и вы не сломаете код. Вот код VBA, используемый в шаблоне.

Примечание. Это было протестировано в Excel 2016, но я не тестировал его в предыдущих версиях.

Об авторе

Джон МакДугалл

Джон — Microsoft MVP, внештатный консультант и тренер, специализирующийся на Excel, Power BI, Power Automate, Power Apps и SharePoint. Другие интересные статьи Джона можно найти в его блоге или на канале YouTube.

Что делать, если уже существует файл с именем, которое будет создано? Поможет ли это в уникальности:
ActiveWorkbook.SaveAs SavePath & ArrayOfUniqueValues(ArrayItem) & Format(Now(), "ГГГГ-ММ-ДД ччммсс") и ".xlsx", 51
(я новичок в VBA)

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

Привет, Джон! Какой замечательный инструмент! Большое спасибо за то, что поделились.У вас есть сценарий VBA, как настроить вывод на ширину столбца с автоподбором? Спасибо дружище!

1 апреля 2018 г., 00:38.
Привет всем!

У меня есть мастер-файл со следующими заголовками

S №
Товар
Цена
Кол-во
Итого
Распределено
Задача1
Задача2
Задача3
Задача4
Завершено
Сводные
комментарии
Член команды

Руководитель группы вводит данные в первые 3 столбца и выбирает имя члена команды, которому будет поручено задание для столбца 14.

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

Члены команды выполняют задачи и заполняют столбцы Задача1, Задача2, Задача3, Задача4, а затем указывают дату выполнения.

Когда руководитель группы запускает следующие макросы

Sub BringInAllCompletedData()
Вызов SortAllFiles
Вызов LoopThroughDirectory
Вызов UpdateDateInSheet1ColK
Вызов UpdateOriginalData
Вызов ClearSheet1
End Sub

Вся выполненная работа консолидируется.

Sub ExportByName()
Dim unique(1000) As String
Dim wb(1000) As Workbook
Dim ws As Worksheet
Dim x As Long
Dim y As Long
Dim ct As Long
Dim uCol As Long

При ошибке Перейти к обработчику ошибок

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

«Ваша основная информация о рабочем листе.
Set ws = ActiveWorkbook.Sheets("OriginalData")

Пусть uCol = 14 ‘Столбец O

Dim Strt As Long, Stp As Long: Пусть Strt = ws.Cells(ws.Rows.Count, 6).End(xlUp).Row + 1: Stp = ws.Cells(ws.Rows.Count, uCol ).Конец

Let ws.Range("F" & Strt & ":F" & Stp & "").Value = Format(Date, "dd/mmm/yyyy") ' добавление дат в новые строки

Пусть ws.Range("A" & Strt & ":A" & Stp & "").Value = Application.Evaluate("=row(" & Strt & ":" & Stp & ")-1" ) ' добавление S.no. в

Для x = 2 To ws.Cells(ws.Rows.Count, uCol).End(xlUp).Row
If CountIfArray(ActiveSheet.Cells(x, uCol), unique()) = 0 Then
unique(ct) = ActiveSheet.Cells(x, uCol).Text
ct = ct + 1
Конец, если
Следующий x

Для x = 0 To ws.Cells(ws.Rows.Count, uCol).End(xlUp).Row – 1
If unique(x) «» Then
If Dir(ThisWorkbook. Путь & «\» & уникальный (x) & «.xlsx», vbNormal) = «» Тогда «Если уникальный файл не существует

Workbooks.Add: Установить wb(x) = ActiveWorkbook
ws.Range(ws.Cells(1, 1), ws.Cells(1, uCol)).Копировать wb(x).Sheets(1 ).Cells(1, 1)
Еще
Workbooks.Open filename:=ThisWorkbook.Path & «\» & unique(x) & «.xlsx»
Set wb(x) = ActiveWorkbook
Конец, если

For y = Strt To Stp
Если ws.Cells(y, uCol) = unique(x) Then
ws.Range(ws.Cells(y, 1), ws.Cells(y , uCol)).Копировать
wb(x).Sheets(1).Cells(WorksheetFunction.CountA(wb(x).Sheets(1).Columns(uCol)) + 1, 1).PasteSpecial

Paste:=xlPasteValuesAndNumberFormats
End If
Next y
'autofit
wb(x).Sheets(1).Columns.AutoFit
wb(x) .SaveAs ThisWorkbook.Path & "\" & unique(x) & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
wb(x).Close SaveChanges:=True
Else
'Выйти из цикла
Выйти из-за
Конец, если
Следующий x

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

ErrHandler:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Открытая функция CountIfArray(lookup_value As String, lookup_array As Variant)
CountIfArray = Application.Count(Application.Match(lookup_value, lookup_array, 0))
Конечная функция

Sub BringInAllCompletedData()
Вызов SortAllFiles
Вызов LoopThroughDirectory
Вызов UpdateDateInSheet1ColK
Вызов UpdateOriginalData
Вызов ClearSheet1
End Sub

folderPath = ActiveWorkbook.Path & "\" 'изменить в соответствии с
If Right(folderPath, 1) "\" Then folderPath = folderPath + "\"
filename = Dir(folderPath & "* .xlsx")
Do While filename ""
Application.ScreenUpdating = False
Set wb = Workbooks.Open(folderPath & filename)
'Здесь вызов подпрограммы для работы с только что открытая книга
Если имя файла = «zmaster.xlsm», То
Выйти из подчиненного
Иначе
Вызвать SortSheet1InAllFiles
Конец, если
имя файла = Dir
>Цикл
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Sub SortSheet1InAllFiles()
Dim MyFile As String
Dim eRow As Long
Dim RowsConsolidated As Long
Dim LastRow As Long
Dim i As Long

eRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

Cells.Select
ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Добавить ключ:=Range("K2:K" & eRow) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
с ActiveWorkbook.Worksheets("Sheet1").Sort < br />.SetRange Range("A1:N" & eRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Применить
Завершить с помощью
ActiveWorkbook. Сохранить
диапазон ("A1"). Выбрать
ActiveWorkbook.Закрыть

Sub LoopThroughDirectory()
Размывание MyFile As String
Размывание eRow As Long
Размытие LRL As Long
Размытие LRK As Long
Dim i As Long

Затемнить FilePath как строку
FilePath = ActiveWorkbook.Path & "\"

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets("Sheet1").Activate
MyFile = Dir(FilePath)
Do While Len(MyFile) > 0
Если MyFile = «zmaster.xlsm», то
Выйти из подпункта
Конец, если

Workbooks.Open (FilePath & MyFile)
LRK = Cells(Rows.Count, 11).End(xlUp).Offset(1, 0).Row 'Столбец L
LRL = Cells( Rows.Count, 12).End(xlUp).Offset(1, 0).Row 'Столбец K

For i = LRL To LRK
Range("A" & LRL & " : " & "K" & LRK).Копировать
Далее
ActiveWorkbook.Close

eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets(“Sheet1”).Range(Cells( eRow, 1), Ячейки(eRow, 11))

Если MyFile = «zmaster.xlsm», то
Выйти из подпункта
Конец, если

MyFile = Dir
ActiveWorkbook.Save
Loop

Столбцы("A:D").Выберите
ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Очистить
ActiveWorkbook.Worksheets("Лист1").Sort.SortFields.Добавить ключ :=Range("A2:A" & eRow) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
с ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:D" & eRow)
. Header = xlYes
. MatchCase = False
. Orientation = xlTopToBottom
.SortMethod = xlPinYin
. Применить
Конец с

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Sub UpdateDateInSheet1ColK()
Размерить строку до длины
Размерить до длины

Листы("Лист1").Активировать
eRow = Sheets("Лист1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
For i = 2 To eRow
If Range("K" & i) "" Then
Range("L" & i).Value = Format(Date, "dd/mmm/yyyy") < br />Конец, если
Следующий
Конец подпункта

LastRow1 = Sheets("Лист1").Range("A" & Rows.Count).End(xlUp).Row
LastRow2 = Sheets("Исходные данные").Range("A" & Rows. Количество).Конец(xlUp).Строка

Для i = 2 To LastRow1
SNo = Sheets("Sheet1").Cells(i, "A").Value
Sheets("OriginalData").Активировать
For j = 2 В LastRow2
Если Листы("ИсходныеДанные").Ячейки(j, "A").Значение = SНет Тогда
Листы("Лист1").Активировать
Листы("Лист1" ).Range(Cells(i, "G"), Cells(i, "L")).Копировать
Листы("ИсходныеДанные"). Активировать
Листы("ИсходныеДанные").Range(Ячейки (j, "G"), Cells(j, "L")). Выберите
ActiveSheet.Paste
Конец, если
Далее j
Application.CutCopyMode = False
>Далее
Листы("OriginalData"). Активировать
Ячейки.Выбрать
ActiveWorkbook.Сохранить
Выбор.Столбцы.Автоподбор
Диапазон("A1").Выбрать

Sub ClearSheet1()
Затемнение строки до заданной длины

Листы("Лист1").Активировать
eRow = Sheets("Лист1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

Range("A2:O" & eRow).Select
Selection.ClearContents
Selection.Columns.AutoFit
Range("A1"). Select
ActiveWorkbook.Save
Конец подписки
[/code]

Это законченный проект, и я использую его на работе.

Я могу это сделать, главным образом, благодаря гуру Динешу Кумару Такьяру.

Я новичок в Excel VBA, и мне нужна небольшая помощь с вашим кодом. Мне нужно сделать именно то, что вы описываете. Я знаю достаточно, чтобы понять большую часть этого, но в нем вы ссылаетесь на следующее:

ExportCriteria – это именованный диапазон в шаблоне электронной таблицы. Вы можете использовать поле имени в Excel, чтобы перейти к нему и убедиться, что оно существует (возможно, вы случайно удалили его.

Это такой замечательный шаблон! Однако я хотел знать, есть ли способ копировать и вставлять в виде таблицы вместо значений? Я не пытался манипулировать кодом, но не смог в нем разобраться.

Здравствуйте, я не могу скачать файл примера 😦

Я только что проверил. Работает отлично. Нажмите оранжевую кнопку, затем нажмите значок загрузки в правом верхнем углу.

Привет, Джон! Большое спасибо за этот шаблон! отлично работает!!
Как бы вы порекомендовали мне отредактировать код, чтобы вместо выбора всех отфильтрованных строк он выбирал только первые 25 (дополнительно к заголовку)?

Судя по тому, как работает этот код, изменить его для этого невозможно. В Excel нет возможности фильтровать первые N элементов.

Если вы добавили столбец к своим данным, который был индексом для каждого уникального элемента в этом поле, вы могли бы добавить фильтр критериев для индекса >= 25.

ws.ListObjects("Данные").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)

Вам необходимо соответствующим образом изменить указанную выше строку кода с помощью параметра Criteria2. Удачи!

Столбец «Критерии экспорта», который я использовал, не должен присутствовать в файлах, созданных макросом. Не могли бы вы помочь мне с этим?

Это решило мою проблему — теперь, если бы они только дали мне прибавку к зарплате, лол. Спасибо, Джон!

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

set ws = Sheets("Данные","Списки","FX")

Если я правильно читаю ваш код, я не думаю, что включение дополнительных рабочих листов повлияет на то, как ваш код выполняется. Мне просто нужно добавить код для копирования дополнительных рабочих листов.

Если вы получаете много писем и вам нужно проанализировать содержащиеся в них данные, импорт писем из Outlook в Excel с помощью VBA сэкономит вам много времени. В этом посте мы собираемся изучить способ импорта всех электронных писем в заданной папке, которые были получены после определенной даты. Очевидно, что для этого на вашем компьютере должен быть установлен Microsoft Outlook.

Если вы не знакомы с VBA, вероятно, было бы неплохо прочитать этот пост о том, как использовать код VBA, который вы найдете в Интернете, прежде чем продолжить чтение и работу с заполненной книгой.

Для этого кода вам потребуется включенная библиотека объектов Microsoft Outlook 16.0. В визуальном базовом редакторе перейдите в «Инструменты», затем «Ссылки», установите флажок рядом с ним и нажмите кнопку «ОК», чтобы включить его.

В этом примере я буду импортировать данные из папки Outlook с именем Inbox/Net Sales Report/Sales. Если вы хотите импортировать из подпапки Sales, вам нужно будет добавить еще один .Folders («Имя подпапки») в строку кода Set Folder =.

Я добавил именованные диапазоны в книгу, ссылаясь на ячейку с именованным диапазоном в VBA, а не на общий адрес ячейки, такой как Range("A1"), что означает, что вы можете перемещать элементы в своей книге, не беспокоясь о нарушении код. Это именованные диапазоны, которые будет использовать код.

From_date: эта ячейка позволит пользователю ввести дату отправителя, чтобы возвращались только электронные письма, полученные (и находящиеся в нашей папке «Продажи») после этой даты.
eMail_subject — эта ячейка содержит заголовок столбца Subject. Темы из электронных писем будут импортированы чуть ниже этой ячейки.
eMail_date — эта ячейка содержит заголовок столбца Дата. Дата, полученная из электронных писем, будет импортирована сразу под этой ячейкой.
eMail_sender — эта ячейка содержит заголовок столбца Sender. Информация об отправителе из электронных писем будет импортирована сразу под этой ячейкой.
eMail_text — эта ячейка содержит заголовок столбца Текст электронной почты. Основной текст из электронных писем будет импортирован сразу под этой ячейкой.

Вот код.

Это довольно простая процедура VBA, но она может быть очень полезна, если вам приходится иметь дело с большим количеством похожих электронных писем.

Читайте также:

Экспорт из Excel в Excel VBA

Как это работает?

Код VBA

Копировать макросы из другой книги

Проверить скопированный макрос

БЕСПЛАТНЫЙ краткий справочник

Об авторе

Джон МакДугалл

Подписаться

Похожие записи

4 способа удалить ненужные пробелы

Как автоматизировать сортировку, скрытие, отображение и перечисление ваших листов

Как создать папки для удаления и переименования из списка

Комментарии

16 комментариев