Добрый день дамы и господа Есть два открытых файла Excel. Название одного из них всегда содержит "М29*...", название второго меняется "Nnn". Нужно в первый открытый файл "М29..." скопировать активный лист из второго открытого файла "Nnn" (во втором файле может быть и много листов). Ранее я думал, что необходимо чётко прописывать наименования книг, листов, но наткнулся на этот код: [vba]
Код
Sub О() Dim iPath$, iFileName$ iPath = ThisWorkbook.Path & "\" iFileName = Dir(iPath & "*.xls") Do Until iFileName = "" If iFileName <> ThisWorkbook.Name Then ThisWorkbook.Sheets.Add , , , iPath & iFileName End If iFileName = Dir Loop End Sub
[/vba] Попробовал его при следующих условиях: На рабочем столе сохранён Excel с поддержкой макросов "Макросы", открыты обе книги ("М29..." и "Nnn"), запускаю макрос из панели быстрого доступа. Что на первом файле запускаю, что на втором - результат одинаков: копируется первый лист файла "М29..." в файл "Макросы". Пусть не правильно,.. пусть не то и не туда, но копируется же.
Добрый день дамы и господа Есть два открытых файла Excel. Название одного из них всегда содержит "М29*...", название второго меняется "Nnn". Нужно в первый открытый файл "М29..." скопировать активный лист из второго открытого файла "Nnn" (во втором файле может быть и много листов). Ранее я думал, что необходимо чётко прописывать наименования книг, листов, но наткнулся на этот код: [vba]
Код
Sub О() Dim iPath$, iFileName$ iPath = ThisWorkbook.Path & "\" iFileName = Dir(iPath & "*.xls") Do Until iFileName = "" If iFileName <> ThisWorkbook.Name Then ThisWorkbook.Sheets.Add , , , iPath & iFileName End If iFileName = Dir Loop End Sub
[/vba] Попробовал его при следующих условиях: На рабочем столе сохранён Excel с поддержкой макросов "Макросы", открыты обе книги ("М29..." и "Nnn"), запускаю макрос из панели быстрого доступа. Что на первом файле запускаю, что на втором - результат одинаков: копируется первый лист файла "М29..." в файл "Макросы". Пусть не правильно,.. пусть не то и не туда, но копируется же.Yar4i
Приведенный Вами макрос просматривает ВСЮ папку, где лежит файл с макросом. Из ВСЕХ файлов с расширением xls он выдергивает по листку и копирует в файл с макросом. Причем, похоже для этого даже необязательно: открыты ли они.
Для Вашей цели достаточно находиться на листе, который должен быть скопирован и одной строки: [vba]
[/vba] Вместо "М29...", конечно же, должно быть полное имя файла с расширением. Приведенный пример вставляет новый лист в конец книги (правее всех). А вот так он будет вставлен левее всех: [vba]
Приведенный Вами макрос просматривает ВСЮ папку, где лежит файл с макросом. Из ВСЕХ файлов с расширением xls он выдергивает по листку и копирует в файл с макросом. Причем, похоже для этого даже необязательно: открыты ли они.
Для Вашей цели достаточно находиться на листе, который должен быть скопирован и одной строки: [vba]
[/vba] Вместо "М29...", конечно же, должно быть полное имя файла с расширением. Приведенный пример вставляет новый лист в конец книги (правее всех). А вот так он будет вставлен левее всех: [vba]
Sub otl() Dim wbn As String, wb As Object wbn = "" For Each wb In Application.Workbooks If Left(wb.Name, 3) = "М29" Then wbn = wb.Name End If Next wb If Len(wbn) = 0 Then MsgBox "Нет такой книги" Exit Sub End If ActiveSheet.Copy Before:=Workbooks(wbn).Sheets(1) End Sub
[/vba] хотя бы так. Найдет начинающуюся с "М29" книгу. Вот только если такая не одна, затрудняюсь сказать: какую из них.
Ну почему же никак... [vba]
Код
Sub otl() Dim wbn As String, wb As Object wbn = "" For Each wb In Application.Workbooks If Left(wb.Name, 3) = "М29" Then wbn = wb.Name End If Next wb If Len(wbn) = 0 Then MsgBox "Нет такой книги" Exit Sub End If ActiveSheet.Copy Before:=Workbooks(wbn).Sheets(1) End Sub
[/vba] хотя бы так. Найдет начинающуюся с "М29" книгу. Вот только если такая не одна, затрудняюсь сказать: какую из них.Perfect2You
Выскочила разовая ошибка «Не удается вставить листы в конечную книгу, так как она содержит меньшее число строк и столбцов, чем исходная книга.» Нашёл решение: пересохранить в другом расширении файл "донор" *.xlsx или *.xls. Но суть ошибки не понял какая разница, где сколько листов, столбцов.
Выскочила разовая ошибка «Не удается вставить листы в конечную книгу, так как она содержит меньшее число строк и столбцов, чем исходная книга.» Нашёл решение: пересохранить в другом расширении файл "донор" *.xlsx или *.xls. Но суть ошибки не понял какая разница, где сколько листов, столбцов.Yar4i
Спасибо. Я "донорский" файл хочу предварительно пересохранить в новом формате, чтоб не выскакивала ошибка "«Не удается вставить листы в конечную книгу, так как она содержит меньшее число строк..." (немного не по теме, (а немного и по теме)): [vba]
Спасибо. Я "донорский" файл хочу предварительно пересохранить в новом формате, чтоб не выскакивала ошибка "«Не удается вставить листы в конечную книгу, так как она содержит меньшее число строк..." (немного не по теме, (а немного и по теме)): [vba]
с уже существующим (прежним, т.е. без измиенений). И в то же место, папку И чтоб не было двух одинаковых имен с разными расширениями (задвоения дабы избежать). Открываю любой "донорский" файл, запускаю макрос, где в конце макроса прописан код пересохранения в .xlsx вне зависимости какое сейчас у него расширение.
с уже существующим (прежним, т.е. без измиенений). И в то же место, папку И чтоб не было двух одинаковых имен с разными расширениями (задвоения дабы избежать). Открываю любой "донорский" файл, запускаю макрос, где в конце макроса прописан код пересохранения в .xlsx вне зависимости какое сейчас у него расширение.Yar4i
Сообщение отредактировал Yar4i - Четверг, 16.03.2017, 16:37
On Error Resume Next: Err.Clear ' макрос работает только в Excel 2007 (и более новых версиях) If Val(Application.Version) < 12 Then Exit Sub ' получаем полный путь к текущему файлу Excel oldName$ = ActiveWorkbook.FullName ' выход, если файл уже в нужном формате (XLSX) If UCase$(oldName$) Like "*.XLSX" Then Exit Sub ' формируем новое имя файла (меняем расширение) newName$ = Left(oldName$, InStrRev(oldName$, ".")) & "xlsx" ' сохраняем файл под новым именем в формате XLSX ActiveWorkbook.SaveAs newName$, xlExcel12 ' удаляем прежний файл (в старом формате) If Err = 0 Then Kill oldName$
[/vba]
Нашёл многоходовочку, но не идёт она: [vba]
Код
On Error Resume Next: Err.Clear ' макрос работает только в Excel 2007 (и более новых версиях) If Val(Application.Version) < 12 Then Exit Sub ' получаем полный путь к текущему файлу Excel oldName$ = ActiveWorkbook.FullName ' выход, если файл уже в нужном формате (XLSX) If UCase$(oldName$) Like "*.XLSX" Then Exit Sub ' формируем новое имя файла (меняем расширение) newName$ = Left(oldName$, InStrRev(oldName$, ".")) & "xlsx" ' сохраняем файл под новым именем в формате XLSX ActiveWorkbook.SaveAs newName$, xlExcel12 ' удаляем прежний файл (в старом формате) If Err = 0 Then Kill oldName$
Yar4i, Даже если Вы откроете файл xls и пересохраните его в xlsx, то все равно в этот файл Вы не всунете другой лист из файла xlsx - ругаться будет. Чтобы все получилось, Вам нужно пересохранить файл (это правильно Вы делаете), закрыть его и открыть заново А по поводу
с уже существующим (прежним, т.е. без измиенений). И в то же место, папку
посмотрите в моем посте выше я привел пример кода А вообще Вам примерно вот такой код нужен [vba]
Код
Sub tttt() With ActiveWorkbook fn_ = .Name If fn_ = ThisWorkbook.Name Then Exit Sub If LCase(Right(fn_, 4)) = ".xls" Then fn1_ = Left(fn_, Len(fn_) - 4) fp_ = .Path & Application.PathSeparator & fn1_ & ".xlsx" Application.DisplayAlerts = 0 .SaveAs Filename:=fp_, FileFormat:=xlOpenXMLWorkbook Application.DisplayAlerts = 1 .Close Workbooks.Open (fp_) End If End With End Sub
[/vba]
Yar4i, Даже если Вы откроете файл xls и пересохраните его в xlsx, то все равно в этот файл Вы не всунете другой лист из файла xlsx - ругаться будет. Чтобы все получилось, Вам нужно пересохранить файл (это правильно Вы делаете), закрыть его и открыть заново А по поводу
с уже существующим (прежним, т.е. без измиенений). И в то же место, папку
посмотрите в моем посте выше я привел пример кода А вообще Вам примерно вот такой код нужен [vba]
Код
Sub tttt() With ActiveWorkbook fn_ = .Name If fn_ = ThisWorkbook.Name Then Exit Sub If LCase(Right(fn_, 4)) = ".xls" Then fn1_ = Left(fn_, Len(fn_) - 4) fp_ = .Path & Application.PathSeparator & fn1_ & ".xlsx" Application.DisplayAlerts = 0 .SaveAs Filename:=fp_, FileFormat:=xlOpenXMLWorkbook Application.DisplayAlerts = 1 .Close Workbooks.Open (fp_) End If End With End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
