Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/сохранить файл ексель с именем взятым из указанной ячейки - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
сохранить файл ексель с именем взятым из указанной ячейки
Остячок Дата: Вторник, 01.08.2023, 21:28 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Привет
Нужен макрос :
1 копирование строки по указанной первой ячейке строки файла списка
2 открыть файл-образец, вставить скопированную строку в А18
3 скопировать ячейку С18
4 сохранить файл образец с именем из скопированной ячейки
5 закрыть новый файл
моих знаний автоматической записи макросов не хватило(((
К сообщению приложен файл: obrazec.xls (29.0 Kb) · spisok.xls (32.0 Kb)
 
Ответить
СообщениеПривет
Нужен макрос :
1 копирование строки по указанной первой ячейке строки файла списка
2 открыть файл-образец, вставить скопированную строку в А18
3 скопировать ячейку С18
4 сохранить файл образец с именем из скопированной ячейки
5 закрыть новый файл
моих знаний автоматической записи макросов не хватило(((

Автор - Остячок
Дата добавления - 01.08.2023 в 21:28
MikeVol Дата: Среда, 02.08.2023, 00:53 | Сообщение № 2
Группа: Проверенные
Ранг: Обитатель
Сообщений: 315
Репутация: 61 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
Андрей7212, Здравствуйте. Как вариант.
[vba]
Код

Option Explicit

' Вставить данный код в Файл Список
Sub CopyAndSaveTemplate()
    
    ' Отключаем мерцание экрана
    Application.ScreenUpdating = False

    ' Указываем путь к файлу образцу
    Dim templateFilePath As String: templateFilePath = ThisWorkbook.Path & "\obrazec.xls"

    ' Определяем активный лист с данными
    Dim SourceWS   As Worksheet: Set SourceWS = ActiveSheet

    ' Открываем файл-образец
    Dim DestWB As Workbook: Set DestWB = Workbooks.Open(templateFilePath)

    ' Определяем первый лист файла образца
    Dim DestWS   As Worksheet: Set DestWS = DestWB.Worksheets(1)

    ' Копируем строку по указанной первой ячейке строки файла списка в файл образец
    DestWS.Range(DestWS.Cells(18, 1), DestWS.Cells(18, 9)).Value = _
            SourceWS.Range(SourceWS.Cells(28, 1), SourceWS.Cells(28, 9)).Value

    ' Получаем имя для нового файла из сячейки C18
    Dim newFileName As String: newFileName = DestWS.Range("C18").Value

    'Отключаем отображение диалоговых окон
    Application.DisplayAlerts = False
    
    ' Сохраняем файл образец с новым именем
    DestWB.SaveAs ThisWorkbook.Path & "\" & newFileName
    
    'Включаем отображение диалоговых окон
    Application.DisplayAlerts = True

    ' Закрываем новый файл
    DestWB.Close SaveChanges:=False
    
    ' Включаем мерцание экрана
    Application.ScreenUpdating = True

    ' Выводим сообщение об удачной выполненной операции
    MsgBox "Данные скопированы!" & vbNewLine & _
            "Новая книга сохранена в Директорию: " & ThisWorkbook.Path & vbNewLine & _
            "Под новым именем: " & newFileName
End Sub
[/vba]
В коде прокоментровал коментариями практически каждую строку кода что делает. Думаю вы разбереётесь. Удачи.


Ученик.
 
Ответить
СообщениеАндрей7212, Здравствуйте. Как вариант.
[vba]
Код

Option Explicit

' Вставить данный код в Файл Список
Sub CopyAndSaveTemplate()
    
    ' Отключаем мерцание экрана
    Application.ScreenUpdating = False

    ' Указываем путь к файлу образцу
    Dim templateFilePath As String: templateFilePath = ThisWorkbook.Path & "\obrazec.xls"

    ' Определяем активный лист с данными
    Dim SourceWS   As Worksheet: Set SourceWS = ActiveSheet

    ' Открываем файл-образец
    Dim DestWB As Workbook: Set DestWB = Workbooks.Open(templateFilePath)

    ' Определяем первый лист файла образца
    Dim DestWS   As Worksheet: Set DestWS = DestWB.Worksheets(1)

    ' Копируем строку по указанной первой ячейке строки файла списка в файл образец
    DestWS.Range(DestWS.Cells(18, 1), DestWS.Cells(18, 9)).Value = _
            SourceWS.Range(SourceWS.Cells(28, 1), SourceWS.Cells(28, 9)).Value

    ' Получаем имя для нового файла из сячейки C18
    Dim newFileName As String: newFileName = DestWS.Range("C18").Value

    'Отключаем отображение диалоговых окон
    Application.DisplayAlerts = False
    
    ' Сохраняем файл образец с новым именем
    DestWB.SaveAs ThisWorkbook.Path & "\" & newFileName
    
    'Включаем отображение диалоговых окон
    Application.DisplayAlerts = True

    ' Закрываем новый файл
    DestWB.Close SaveChanges:=False
    
    ' Включаем мерцание экрана
    Application.ScreenUpdating = True

    ' Выводим сообщение об удачной выполненной операции
    MsgBox "Данные скопированы!" & vbNewLine & _
            "Новая книга сохранена в Директорию: " & ThisWorkbook.Path & vbNewLine & _
            "Под новым именем: " & newFileName
End Sub
[/vba]
В коде прокоментровал коментариями практически каждую строку кода что делает. Думаю вы разбереётесь. Удачи.

Автор - MikeVol
Дата добавления - 02.08.2023 в 00:53
Остячок Дата: Среда, 02.08.2023, 20:36 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

MikeVol, MikeVol,
благодарю за ответ,не плохой вариант.
много новых слов увидел))) в моих поисках такого варианта не видел.
есть недоработка, сможете помочь?
новый файл создается только из первой строки, а не с указанной. функции незнакомы для меня, поэтому не полез поправлять.
нужно, чтобы файлы создавались из указанной строки.
' Копируем строку по указанной первой ячейке строки файла списка в файл образец
DestWS.Range(DestWS.Cells(18, 1), DestWS.Cells(18, 9)).Value = _
SourceWS.Range(SourceWS.Cells(28, 1), SourceWS.Cells(28, 9)).Value
здесь жестко прописана конкретная строка 28,1 - 28,9, как ее сделать зависимой от активной ячейки?
заранее благодарен
 
Ответить
СообщениеMikeVol, MikeVol,
благодарю за ответ,не плохой вариант.
много новых слов увидел))) в моих поисках такого варианта не видел.
есть недоработка, сможете помочь?
новый файл создается только из первой строки, а не с указанной. функции незнакомы для меня, поэтому не полез поправлять.
нужно, чтобы файлы создавались из указанной строки.
' Копируем строку по указанной первой ячейке строки файла списка в файл образец
DestWS.Range(DestWS.Cells(18, 1), DestWS.Cells(18, 9)).Value = _
SourceWS.Range(SourceWS.Cells(28, 1), SourceWS.Cells(28, 9)).Value
здесь жестко прописана конкретная строка 28,1 - 28,9, как ее сделать зависимой от активной ячейки?
заранее благодарен

Автор - Остячок
Дата добавления - 02.08.2023 в 20:36
MikeVol Дата: Среда, 02.08.2023, 22:16 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 315
Репутация: 61 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
Остячок, Здравствуйте. Я что-то вообще не могу понять что вы хотите этим сказать
Цитата Остячок, 02.08.2023 в 20:36, в сообщении № 3 ()
Копируем строку по указанной первой ячейке строки файла списка в файл образец

и
Цитата Остячок, 02.08.2023 в 20:36, в сообщении № 3 ()
строка 28,1 - 28,9, как ее сделать зависимой от активной ячейки?

Проясните мне, я не понимаю что вам надо. По какой "указанной первой ячейке строки файла списка в файл образец"?

UPD!
Возможно я и угадаю ваши не понятные объяснения.
Вместо данной строки:
[vba]
Код

    ' Копируем строку по указанной первой ячейке строки файла списка в файл образец
    DestWS.Range(DestWS.Cells(18, 1), DestWS.Cells(18, 9)).Value = _
            SourceWS.Range(SourceWS.Cells(28, 1), SourceWS.Cells(28, 9)).Value
[/vba]
Вставьте слудущие строки:
[vba]
Код
    
    ' Активируем книгу список
    SourceWS.Activate

    ' Получаем номер текущей активной строки
    Dim activeRow   As Long: activeRow = ActiveCell.Row

    DestWS.Range(DestWS.Cells(18, 1), DestWS.Cells(18, 9)).Value = _
            SourceWS.Range(SourceWS.Cells(activeRow, 1), SourceWS.Cells(activeRow, 9)).Value
[/vba]
Теперь если активируете (Выберите любую ячейку мышкой на листе) то та строка и скопируется в книгу Образец.


Ученик.

Сообщение отредактировал MikeVol - Среда, 02.08.2023, 23:37
 
Ответить
СообщениеОстячок, Здравствуйте. Я что-то вообще не могу понять что вы хотите этим сказать
Цитата Остячок, 02.08.2023 в 20:36, в сообщении № 3 ()
Копируем строку по указанной первой ячейке строки файла списка в файл образец

и
Цитата Остячок, 02.08.2023 в 20:36, в сообщении № 3 ()
строка 28,1 - 28,9, как ее сделать зависимой от активной ячейки?

Проясните мне, я не понимаю что вам надо. По какой "указанной первой ячейке строки файла списка в файл образец"?

UPD!
Возможно я и угадаю ваши не понятные объяснения.
Вместо данной строки:
[vba]
Код

    ' Копируем строку по указанной первой ячейке строки файла списка в файл образец
    DestWS.Range(DestWS.Cells(18, 1), DestWS.Cells(18, 9)).Value = _
            SourceWS.Range(SourceWS.Cells(28, 1), SourceWS.Cells(28, 9)).Value
[/vba]
Вставьте слудущие строки:
[vba]
Код
    
    ' Активируем книгу список
    SourceWS.Activate

    ' Получаем номер текущей активной строки
    Dim activeRow   As Long: activeRow = ActiveCell.Row

    DestWS.Range(DestWS.Cells(18, 1), DestWS.Cells(18, 9)).Value = _
            SourceWS.Range(SourceWS.Cells(activeRow, 1), SourceWS.Cells(activeRow, 9)).Value
[/vba]
Теперь если активируете (Выберите любую ячейку мышкой на листе) то та строка и скопируется в книгу Образец.

Автор - MikeVol
Дата добавления - 02.08.2023 в 22:16
Остячок Дата: Четверг, 03.08.2023, 12:13 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

MikeVol,
по моему вы все прекрасно поняли)))
все чудесно работает
как могу отблагодарить?
 
Ответить
СообщениеMikeVol,
по моему вы все прекрасно поняли)))
все чудесно работает
как могу отблагодарить?

Автор - Остячок
Дата добавления - 03.08.2023 в 12:13
MikeVol Дата: Четверг, 03.08.2023, 12:42 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 315
Репутация: 61 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
Цитата Остячок, 03.08.2023 в 12:13, в сообщении № 5 ()
как могу отблагодарить?

Хорошим Словом и на том Спасибо!


Ученик.
 
Ответить
Сообщение
Цитата Остячок, 03.08.2023 в 12:13, в сообщении № 5 ()
как могу отблагодарить?

Хорошим Словом и на том Спасибо!

Автор - MikeVol
Дата добавления - 03.08.2023 в 12:42
Serge_007 Дата: Четверг, 03.08.2023, 13:07 | Сообщение № 7
Группа: Админы
Ранг: Местный житель
Сообщений: 16475
Репутация: 2749 ±
Замечаний: ±

Excel 2016
Хорошим Словом
, которое можно сказать в Книге отзывов yes


ЮMoney:41001419691823 | WMR:126292472390
 
Ответить
Сообщение
Хорошим Словом
, которое можно сказать в Книге отзывов yes

Автор - Serge_007
Дата добавления - 03.08.2023 в 13:07
Остячок Дата: Пятница, 04.08.2023, 20:02 | Сообщение № 8
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Хороших слов не жалко. Большущее спасибо за решение вопроса.
Есть еще одна задумка,но она не настолько горящая.
Возможно этот макрос дописать, чтобы он сам проходил по списку, создавая файлы из каждой строки и останавливался при окончании таблицы?
Как бы, что такое цикл древнему юзеру Бэйсика понятно, но вот как выразить на языке VB, не знаю :confused:
 
Ответить
СообщениеХороших слов не жалко. Большущее спасибо за решение вопроса.
Есть еще одна задумка,но она не настолько горящая.
Возможно этот макрос дописать, чтобы он сам проходил по списку, создавая файлы из каждой строки и останавливался при окончании таблицы?
Как бы, что такое цикл древнему юзеру Бэйсика понятно, но вот как выразить на языке VB, не знаю :confused:

Автор - Остячок
Дата добавления - 04.08.2023 в 20:02
cmivadwot Дата: Пятница, 04.08.2023, 20:53 | Сообщение № 9
Группа: Проверенные
Ранг: Обитатель
Сообщений: 479
Репутация: 88 ±
Замечаний: 0% ±

365
Остячок, Добый вечер. Подозреваю, что и в файлы не складывать, а сразу на печать будет еще лучше или с такой возможностью ( в файлы или на печать)?


Сообщение отредактировал cmivadwot - Пятница, 04.08.2023, 21:03
 
Ответить
СообщениеОстячок, Добый вечер. Подозреваю, что и в файлы не складывать, а сразу на печать будет еще лучше или с такой возможностью ( в файлы или на печать)?

Автор - cmivadwot
Дата добавления - 04.08.2023 в 20:53
MikeVol Дата: Пятница, 04.08.2023, 22:41 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 315
Репутация: 61 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
Остячок, Здравствуйте.
Цитата Остячок, 04.08.2023 в 20:02, в сообщении № 8 ()
чтобы он сам проходил по списку, создавая файлы из каждой строки и останавливался при окончании таблицы?

А разве сейчас не так? Код так сейчас и работает, пробегается по списку из столбца J создаёт файлы, цикл останавливается и выдаёт вам сообщение об успешном выполнение своей задачи.
УПС. дал ответ не в той теме. Извините, сейчас дам код.


Ученик.

Сообщение отредактировал MikeVol - Пятница, 04.08.2023, 22:50
 
Ответить
СообщениеОстячок, Здравствуйте.
Цитата Остячок, 04.08.2023 в 20:02, в сообщении № 8 ()
чтобы он сам проходил по списку, создавая файлы из каждой строки и останавливался при окончании таблицы?

А разве сейчас не так? Код так сейчас и работает, пробегается по списку из столбца J создаёт файлы, цикл останавливается и выдаёт вам сообщение об успешном выполнение своей задачи.
УПС. дал ответ не в той теме. Извините, сейчас дам код.

Автор - MikeVol
Дата добавления - 04.08.2023 в 22:41
MikeVol Дата: Пятница, 04.08.2023, 22:53 | Сообщение № 11
Группа: Проверенные
Ранг: Обитатель
Сообщений: 315
Репутация: 61 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
Остячок, Ловите.
[vba]
Код

Option Explicit

' Вставить данный код в Файл Список
Sub CopyAndSaveAllTemplate()
    Dim i           As Long

    ' Отключаем мерцание экрана
    Application.ScreenUpdating = False

    ' Определяем активный лист с данными
    Dim SourceWS    As Worksheet: Set SourceWS = ActiveSheet

    ' Находим последнюю заполненную ячейку в столбце A
    Dim lastRow     As Long: lastRow = SourceWS.Cells(SourceWS.Rows.Count, 1).End(xlUp).Row

    ' Цикл по строкам, от 28 строки и до последней заполненой ячейке строки
    For i = 28 To lastRow

        ' Указываем путь к файлу образцу
        Dim templateFilePath As String: templateFilePath = ThisWorkbook.Path & "\obrazec.xls"

        ' Открываем файл-образец
        Dim DestWB  As Workbook: Set DestWB = Workbooks.Open(templateFilePath)

        ' Определяем первый лист файла образца
        Dim DestWS  As Worksheet: Set DestWS = DestWB.Worksheets(1)

        ' Копируем строку по указанной первой ячейке строки файла списка в файл образец
        DestWS.Range(DestWS.Cells(18, 1), DestWS.Cells(18, 9)).Value = _
                SourceWS.Range(SourceWS.Cells(i, 1), SourceWS.Cells(i, 9)).Value

        ' Получаем имя для нового файла из сячейки C18
        Dim newFileName As String: newFileName = DestWS.Range("C18").Value

        'Отключаем отображение диалоговых окон
        Application.DisplayAlerts = False

        ' Сохраняем файл образец с новым именем
        DestWB.SaveAs ThisWorkbook.Path & "\" & newFileName

        'Включаем отображение диалоговых окон
        Application.DisplayAlerts = True

        ' Закрываем новый файл
        DestWB.Close SaveChanges:=False

    Next i

    ' Включаем мерцание экрана
    Application.ScreenUpdating = True

    ' Выводим сообщение об удачной выполненной операции
    MsgBox "Выполненно! "
End Sub
[/vba]


Ученик.
 
Ответить
СообщениеОстячок, Ловите.
[vba]
Код

Option Explicit

' Вставить данный код в Файл Список
Sub CopyAndSaveAllTemplate()
    Dim i           As Long

    ' Отключаем мерцание экрана
    Application.ScreenUpdating = False

    ' Определяем активный лист с данными
    Dim SourceWS    As Worksheet: Set SourceWS = ActiveSheet

    ' Находим последнюю заполненную ячейку в столбце A
    Dim lastRow     As Long: lastRow = SourceWS.Cells(SourceWS.Rows.Count, 1).End(xlUp).Row

    ' Цикл по строкам, от 28 строки и до последней заполненой ячейке строки
    For i = 28 To lastRow

        ' Указываем путь к файлу образцу
        Dim templateFilePath As String: templateFilePath = ThisWorkbook.Path & "\obrazec.xls"

        ' Открываем файл-образец
        Dim DestWB  As Workbook: Set DestWB = Workbooks.Open(templateFilePath)

        ' Определяем первый лист файла образца
        Dim DestWS  As Worksheet: Set DestWS = DestWB.Worksheets(1)

        ' Копируем строку по указанной первой ячейке строки файла списка в файл образец
        DestWS.Range(DestWS.Cells(18, 1), DestWS.Cells(18, 9)).Value = _
                SourceWS.Range(SourceWS.Cells(i, 1), SourceWS.Cells(i, 9)).Value

        ' Получаем имя для нового файла из сячейки C18
        Dim newFileName As String: newFileName = DestWS.Range("C18").Value

        'Отключаем отображение диалоговых окон
        Application.DisplayAlerts = False

        ' Сохраняем файл образец с новым именем
        DestWB.SaveAs ThisWorkbook.Path & "\" & newFileName

        'Включаем отображение диалоговых окон
        Application.DisplayAlerts = True

        ' Закрываем новый файл
        DestWB.Close SaveChanges:=False

    Next i

    ' Включаем мерцание экрана
    Application.ScreenUpdating = True

    ' Выводим сообщение об удачной выполненной операции
    MsgBox "Выполненно! "
End Sub
[/vba]

Автор - MikeVol
Дата добавления - 04.08.2023 в 22:53
Остячок Дата: Воскресенье, 06.08.2023, 18:56 | Сообщение № 12
Группа: Пользователи
Ранг: Прохожий
Сообщений: 5
Репутация: 0 ±
Замечаний: 0% ±

Благодарю за внимание и уделенное время, уже стыдно писать :(
последнюю строку не определяет, останавливает по ошибке, не может записать пустое имя файла.
но это уже мелочи, и так сэкономлено куча рабочего времени.
Ну и начало опять зафиксировалось на 28й строке, а не на активной ячейке.
Но это тоже мелочи)))) можно прямо в макросе начало переписывать))
ещераз благодарю
 
Ответить
СообщениеБлагодарю за внимание и уделенное время, уже стыдно писать :(
последнюю строку не определяет, останавливает по ошибке, не может записать пустое имя файла.
но это уже мелочи, и так сэкономлено куча рабочего времени.
Ну и начало опять зафиксировалось на 28й строке, а не на активной ячейке.
Но это тоже мелочи)))) можно прямо в макросе начало переписывать))
ещераз благодарю

Автор - Остячок
Дата добавления - 06.08.2023 в 18:56
MikeVol Дата: Воскресенье, 06.08.2023, 19:29 | Сообщение № 13
Группа: Проверенные
Ранг: Обитатель
Сообщений: 315
Репутация: 61 ±
Замечаний: 0% ±

Excel LTSC 2021 EN
Цитата Остячок, 06.08.2023 в 18:56, в сообщении № 12 ()
последнюю строку не определяет, останавливает по ошибке, не может записать пустое имя файла.

На ваших файлах что вы приложили к данной теме последний мой код из #11 поста отрабатывает без единной ошибке. Ищите у себя ошибку.
Цитата Остячок, 06.08.2023 в 18:56, в сообщении № 12 ()
Ну и начало опять зафиксировалось на 28й строке, а не на активной ячейке.

Вы сами себе Противоречите!
Цитата Остячок, 04.08.2023 в 20:02, в сообщении № 8 ()
Возможно этот макрос дописать, чтобы он сам проходил по списку, создавая файлы из каждой строки и останавливался при окончании таблицы?

Что просили то вам и предоставили. Дальше сами. Удачи.


Ученик.

Сообщение отредактировал MikeVol - Воскресенье, 06.08.2023, 19:32
 
Ответить
Сообщение
Цитата Остячок, 06.08.2023 в 18:56, в сообщении № 12 ()
последнюю строку не определяет, останавливает по ошибке, не может записать пустое имя файла.

На ваших файлах что вы приложили к данной теме последний мой код из #11 поста отрабатывает без единной ошибке. Ищите у себя ошибку.
Цитата Остячок, 06.08.2023 в 18:56, в сообщении № 12 ()
Ну и начало опять зафиксировалось на 28й строке, а не на активной ячейке.

Вы сами себе Противоречите!
Цитата Остячок, 04.08.2023 в 20:02, в сообщении № 8 ()
Возможно этот макрос дописать, чтобы он сам проходил по списку, создавая файлы из каждой строки и останавливался при окончании таблицы?

Что просили то вам и предоставили. Дальше сами. Удачи.

Автор - MikeVol
Дата добавления - 06.08.2023 в 19:29
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!