Новости:

Новая редакция правил форума: 2.4. Если вопрос или ответ содержится во вложенном файле, все-равно кратко описывайте в сообщении вопрос или суть решения. Это необходимо, чтобы тему можно было найти через поиск.

Главное меню

Создание книги эксель на основе открытой книги нажатием на кнопку

Автор Sveta, 10.08.2018, 09:16

« назад - далее »

Sveta

Добрый день, дорогие профессионалы!
Прошу у вас срочной помощи!
Ситуация такова:
   Есть книга эксель, которая содержит несколько листов (их очень много). На каждом листе имеются таблицы, содержащие определенную информацию (на каждом листе разные таблицы, в файле из вложения предложены одинаковые таблицы).
   Таблицы имеют 2 столбца "Текущие" и "На конец месяца", которые есть абсолютно на каждом листке книги. 
   Необходимо установить кнопку, при нажатии на которую создавался точно такая же книга (для нового месяца), со всеми вложенными листами в нее и таблицами, но с пустым столбцом "Текущие" (не содержащие никаких значений), т.к. он должен заполнятся вручную, а в столбец "На конец месяца" переносились бы автоматически данными из столбца "Текущие". Можно ли это вообще реализовать и как?? ???

Нашла в интернете код макроса, но он для создания резервной копии.
Sub Macros15()
    ThisWorkbook.SaveCopyAs _
    Filename:=ThisWorkbook.Path & "\" & _
    ThisWorkbook.Name & "" & _
    Format(Date, "dd-mm-yy")
    End Sub
Пожалуйста, помогите мне, если можно...
Откликнитесь... Заранее спасибо!

runner

Я бы сделал так - записал макрорекордером процесс переноса данных из "Текущие" в "На конец месяца" значениями  и очистку исходных данных. После чего добавил бы сохранение под именем формируемым по маске с использованием функций СЕГОДНЯ, МЕСЯЦ или чего-то ещё, по желанию.

Sveta

Теоретически я понимаю, но как реализовать кодом и что куда писать - нет(

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

runner

Sub CopyToNext()
'
' CopyToNext Макрос
'

'
    Sheets("данные1").Select 'начало секции
    Range("D5:D100").Select 'перемещаемый диапазон
    Selection.Copy
    Range("E5").Select  'первая ячейка диапазона куда перемещаем
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D5:D100").Select
    Application.CutCopyMode = False
    Selection.ClearContents 'очистка исходного диапазона
    Range("A1:S1").Select   'конец секции
    Sheets("данные2").Select 'начало секции
    Range("D5:D100").Select 'перемещаемый диапазон
    Selection.Copy
    Range("E5").Select  'первая ячейка диапазона куда перемещаем
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D5:D100").Select
    Application.CutCopyMode = False
    Selection.ClearContents 'очистка исходного диапазона
    Range("A1:S1").Select   'конец секции
    Sheets("данные1").Select
    Range("T1").Select
    ActiveCell.FormulaR1C1 = "=""Акт_""&TEXT(NOW(),""ГГГГ-ММ-ДД"")" 'формирование имени файла
    Range("T1").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Application.ReplaceFormat.Clear 'очистка формата замены
    Dim WbFname$, TFname$, Twb As Workbook
    WbFname = ActiveWorkbook.FullName 'Запоминаем путь к активной книге
    Application.DisplayAlerts = False 'убирает предупреждение о замене и совместимости
    TFname = "C:\Users\*********************\" & Range("T1").Value 'Формируем путь сохранения с именем файла
    'Сохраняем книгу при этом активная книга закрывается и открывается сохраненная
    ActiveWorkbook.SaveAs Filename:=TFname, FileFormat:=xlExcel8, CreateBackup:=False
    Set Twb = ActiveWorkbook 'Запоминаем активную книгу в переменную
    ActiveWorkbook.Close False 'Закрываем книгу из переменной
    Range("A1").Select
End Sub


На один лист(вкладку) приходится одна "секция".
Я в коде сделал две, надо повторить их в том количестве, сколько их в файле, в каждой меняя ("данные1") на ("данные2")("данные3")("данные4") и так далее
Указал диапазон D5:D100, но, конечно же, можно поставить с бОльшим запасом, чтобы хватило наверняка.
И уже после всех секций завершающая часть кода начинающаяся с
    Sheets("данные1").Select
    Range("T1").Select
    ActiveCell.FormulaR1C1 = "=""Акт_""&TEXT(NOW(),""ГГГГ-ММ-ДД"")" 'формирование имени файла


В строке со звёздочками пропишите путь сохранения, как Вам надо.
Если в названии текущее число лишнее -в записи "ГГГГ-ММ-ДД" удалите "-ДД"  - останется только год и месяц.
В качестве побочного эффекта на первом листе в ячейке T1 останется имя файла

Часть кода с сохранением файла принадлежит кому-то из уважаемых форумчан, к стыду своему, не помню кому.


всё сделано исходя из того, что листы(вкладки) одинаковы по структуре. Если это не так, то надо изменить соответственно диапазон копирования[D5:D100] и адрес первой ячейки диапазона куда данные перемещаются [E5].

Sveta

Большое спасибо за отклик.
Если не возражаете, еще один вопрос.

Если у меня строки в таблицах будут добавляться, то все придется переделывать.
Можно ли сделать в цикле?
Например, в столбце АА поставить ключевое слово, например, "начало" (откуда уже идет основная таблица без шапки), т.е. программа будет понимать, что отсюда начинать обрабатывать.  Сделать условие, что если в колонке С есть текст, то переносим данные из колонки "Текущие" в "На конец месяца", и где-то в том же столбце АА есть другое ключевое слово - "конец", которое показывает, что обработку закончить на данном листе.

Не понимаю как правильно написать код, т.к. я вообще не программист. Начала так: (но это грубо говоря для перебора всех листов, которые надо обработать, т.к. в книге листов много, а переносить данные надо не на всех листах. Здесь у меня в том же столбце АА есть символ "!!!", чтобы программа понимала какие листы обрабатывать), но что-то даже это не работает.
Sub Create()
Dim WS_Count As Integer
Dim I As Integer
Dim Y As Integer
Dim r1 As Integer
Dim r2 As Integer

WS_Count = ActiveWorkbook.Worksheets.Count

For I = 1 To WS_Count
     For r2 = 1 To 50
     If Cells(r1, r2).Value = "!!!" Then MsgBox ("!!!")
    Next 
Next I
End Sub

runner

Если строки будут добавляться, но структура столбцов и первая задействованная строка неизменны,  то просто увеличьте диапазон до размера заведомо превышающего возможное количество добавляемых строк - пусть будет не D5:D100 а D5:D1000 - уверен, тормозов не заметите.

Я тоже не программист, к сожалению, поэтому такой цикл не напишу :(
Кстати, я бы использовал в качестве опорного вместо "!" какой-нибудь другой знак - восклицательный знак при поиске может восприниматься как любой единичный символ (как звёздочка - любое количество любых символов)

GWolf

Цитата: Sveta от 14.08.2018, 15:54
... но что-то даже это не работает.

Доброго времени суток!

Ваш код, к сожалению, работать и не будет. Ну, в смысле - по листам "ходить".
А вот так: Sub stepS()
    Dim Wss As Worksheet
   
    For Each Wss In ActiveWorkbook.Worksheets
        Wss.Select '- это просто, что бы было видно, что действительно "шагаем"
        MsgBox Wss.Name ' - ну а тут оповещаем где находимся.
    Next
End Sub
будет.

Будут вопросы - спрашивайте.
Путей к вершине - множество. Этот один из многих!