сохранить файл ексель с именем взятым из указанной ячейки

Дата: Вторник, 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)

Дата: Среда, 02.08.2023, 00:53 | Сообщение № 2

Группа: Проверенные

Ранг: Обитатель

Сообщений: 318

Репутация: 64 ±

Замечаний: 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]

Код

[/vba]
В коде прокоментровал коментариями практически каждую строку кода что делает. Думаю вы разбереётесь. Удачи.MikeVol

Ученик.

СообщениеАндрей7212, Здравствуйте. Как вариант.
[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, как ее сделать зависимой от активной ячейки?
заранее благодарен

Дата: Среда, 02.08.2023, 22:16 | Сообщение № 4

Группа: Проверенные

Ранг: Обитатель

Сообщений: 318

Репутация: 64 ±

Замечаний: 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

Дата: Четверг, 03.08.2023, 12:13 | Сообщение № 5

Группа: Пользователи

Ранг: Прохожий

Сообщений: 5

Репутация: 0 ±

Замечаний: 0% ±

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

Дата: Четверг, 03.08.2023, 12:42 | Сообщение № 6

Группа: Проверенные

Ранг: Обитатель

Сообщений: 318

Репутация: 64 ±

Замечаний: 0% ±

Excel LTSC 2021 EN

Цитата Остячок, 03.08.2023 в 12:13, в сообщении № 5 (

)

как могу отблагодарить?

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

Ученик.

Serge_007

Дата: Четверг, 03.08.2023, 13:07 | Сообщение № 7

Группа: Админы

Ранг: Местный житель

Сообщений: 16475

Репутация: 2749 ±

Замечаний: ±

Excel 2016

Цитата MikeVol, 03.08.2023 в 12:42, в сообщении № 6 (

)

Хорошим Словом

, которое можно сказать в Книге отзывов yes

ЮMoney:41001419691823 | WMR:126292472390

Дата: Пятница, 04.08.2023, 20:02 | Сообщение № 8

Группа: Пользователи

Ранг: Прохожий

Сообщений: 5

Репутация: 0 ±

Замечаний: 0% ±

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

cmivadwot

Дата: Пятница, 04.08.2023, 20:53 | Сообщение № 9

Группа: Проверенные

Ранг: Обитатель

Сообщений: 497

Репутация: 93 ±

Замечаний: 0% ±

365

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

Сообщение отредактировал cmivadwot - Пятница, 04.08.2023, 21:03

Дата: Пятница, 04.08.2023, 22:41 | Сообщение № 10

Группа: Проверенные

Ранг: Обитатель

Сообщений: 318

Репутация: 64 ±

Замечаний: 0% ±

Excel LTSC 2021 EN

Остячок, Здравствуйте.

Цитата Остячок, 04.08.2023 в 20:02, в сообщении № 8 (

)

чтобы он сам проходил по списку, создавая файлы из каждой строки и останавливался при окончании таблицы?

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

Ученик.

Сообщение отредактировал MikeVol - Пятница, 04.08.2023, 22:50

Дата: Пятница, 04.08.2023, 22:53 | Сообщение № 11

Группа: Проверенные

Ранг: Обитатель

Сообщений: 318

Репутация: 64 ±

Замечаний: 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]

Код

[/vba]MikeVol

Ученик.

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

Код

[/vba]

Автор - MikeVol
Дата добавления - 04.08.2023 в 22:53