Макрос на копирование листа с датой

[Денис2206]

Здравствуйте.
Написал макрос чтобы можно было копировать предыдущий лист с изменением даты
Проблема в том что копирует теперь по 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]

могу скинуть сам файл

[ВладимирC]

А если попробовать убрать эту часть:

	
	
'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

[Zefyry]

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

ActiveCell.FormulaR1C1 = "=NOW()"

на:

ActiveCell.Value = Date

И ваша дата будет оставаться статичной.

[Zefyry]

А два листа у вас копируется, потому что у вас вопрос так и ставится "Укажите количество копируемых листов", вы указываете 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]

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)

и это убрать

[Serge 007]

Кросс