Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 08.06.2023, 15:56   #1
Денис2206
Новичок
Джуниор
 
Регистрация: 08.06.2023
Сообщений: 2
По умолчанию Макрос на копирование листа с датой

Здравствуйте.
Написал макрос чтобы можно было копировать предыдущий лист с изменением даты
Проблема в том что копирует теперь по 2 листа 1копия предыдущего листа полностью второй это новый лист с текущей датой. Как убрать копирование 1 листа с датой прошлого листа?
и еще проблема. мне надо ежедневно копировать лист с новой датой, но из за макроса сегодня вчерашняя дата на предыдущих листах тоже меняется на текущей а не остается той которой нужно. Помогите.

Вот макрос, в чем ошибки?

Sub КопияЛиста()

'Перемещение листа
'Копирование и перемещение
Dim kolvo As Variant
Dim i As Long
Dim list As Worksheet
kolvo = InputBox("Укажите количество копируемых листов")
If kolvo = "0" Then Exit Sub
If IsNumeric(kolvo) Then
kolvo = Fix(kolvo)
Set list = ActiveSheet
For i = 1 To kolvo
list.Copy after:=ActiveSheet
ActiveSheet.Name = list.Name & i
Next
Else
MsgBox "Неправильно указано количество"
End If

'Переименование
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.CutCopyMode = False

Sheets(Sheets.Count).Copy after:=Sheets(Sheets.Count)
On Error Resume Next
Sheets(Sheets.Count).Name = Date

Application.CutCopyMode = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True

'ПростановкаТекущейДатыОтчета
Range("G2").Select
ActiveCell.FormulaR1C1 = "=NOW()"

'Data
Sheets("Альфа").Copy after:=Sheets(Sheets.Count)
ActiveSheet.[d2] = ActiveSheet.[d2] + 1

End Sub
Денис2206 вне форума Ответить с цитированием
Старый 08.06.2023, 18:20   #2
Денис2206
Новичок
Джуниор
 
Регистрация: 08.06.2023
Сообщений: 2
По умолчанию

могу скинуть сам файл
Денис2206 вне форума Ответить с цитированием
Старый 11.06.2023, 20:02   #3
ВладимирC
 
Регистрация: 31.03.2015
Сообщений: 4
По умолчанию

А если попробовать убрать эту часть:
Код:
Код:
'If IsNumeric(kolvo) Then
'kolvo = Fix(kolvo)
'Set list = ActiveSheet
'For i = 1 To kolvo
'list.Copy after:=ActiveSheet
'ActiveSheet.Name = list.Name & i
'Next
'Else
'MsgBox "Неправильно указано количество"
'End If
ВладимирC вне форума Ответить с цитированием
Старый 14.06.2023, 15:31   #4
Zefyry
 
Регистрация: 05.09.2022
Сообщений: 8
По умолчанию

Согласно описанию, надо копировать какой-то лист постоянно, но в коде зачем-то идет запрос на количество копируемых листов. Если все же копировать надо 1 лист, то могу предложить решение, чтобы при открытии файла шла проверка листов, выбирался лист с максимальной датой в ячейке "G2" и копировался, если эта дата не совпадает с сегодняшним днем.
А дата везде у вас меняется не из-за макроса, а из-за того, что вы дату заносите как формулу показывающую текущую дату, замените:

ActiveCell.FormulaR1C1 = "=NOW()"

на:

ActiveCell.Value = Date

И ваша дата будет оставаться статичной.
Zefyry вне форума Ответить с цитированием
Старый 14.06.2023, 15:46   #5
Zefyry
 
Регистрация: 05.09.2022
Сообщений: 8
По умолчанию

А два листа у вас копируется, потому что у вас вопрос так и ставится "Укажите количество копируемых листов", вы указываете 2 и копируется 2 листа, укажите 3, будет копироваться 3 листа, при чем по сути вы все время будете копировать один и тот же лист, т.к. вы копируете лист, при копировании новый лист становится активным и вы снова копируете прошлый лист вставляя его с новым номером следом за скопированным. Если вам нужно копировать лист и задавать ему имя с номером который вы указываете, то уберите совсем цикл For (только сам цикл, тело оставьте), а вместо его переменной "i" вставляйте "kolvo", ну т.е. вместо:
Код:
For i = 1 To kolvo
list.Copy after:=ActiveSheet
ActiveSheet.Name = list.Name & i
Next
вставьте:
Код:
list.Copy after:=ActiveSheet
ActiveSheet.Name = list.Name & kolvo
Zefyry вне форума Ответить с цитированием
Старый 14.06.2023, 15:54   #6
Zefyry
 
Регистрация: 05.09.2022
Сообщений: 8
По умолчанию

Код:
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.CutCopyMode = False

Sheets(Sheets.Count).Copy after:=Sheets(Sheets.Count)
On Error Resume Next
Sheets(Sheets.Count).Name = Date

Application.CutCopyMode = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
убрать
Код:
Sheets("Альфа").Copy after:=Sheets(Sheets.Count)
и это убрать
Zefyry вне форума Ответить с цитированием
Старый 14.06.2023, 16:06   #7
Serge 007
Участник клуба
 
Аватар для Serge 007
 
Регистрация: 15.12.2009
Сообщений: 1,448
По умолчанию

Кросс
Бесплатная помощь: www.excelworld.ru
Платная помощь: serge_007.planetaexcel@mail.ru
https://yoomoney.ru: 41001419691823
Serge 007 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Макрос создания нового листа (заданного формата) с переносом данных с другого листа alpochino Помощь студентам 0 23.04.2019 10:47
Макрос для поиска ячейки с текущей датой artamonkostuk Microsoft Office Excel 2 20.03.2018 00:59
макрос на выполнение условия с датой. Pasha_Z Microsoft Office Excel 4 12.01.2014 19:48
Копирование файла с датой в имени random_name Общие вопросы C/C++ 2 15.09.2012 21:47
копирование БД с датой и временем в имени brednew БД в Delphi 4 12.09.2012 21:03