Макрос для создания листа с зафиксированной текущей датой

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос для создания листа с зафиксированной текущей датой (Макросы/Sub)

den4ik2206

Дата: Суббота, 10.06.2023, 19:11 | Сообщение № 1

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

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

Сообщений: 2

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

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

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

[vba]

Код

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

[/vba]

К сообщению приложен файл: primer_dlja_redakcii.xlsm (209.5 Kb)

Сообщение отредактировал Serge_007 - Среда, 14.06.2023, 14:39

Ответить

WowGun

Дата: Суббота, 10.06.2023, 20:40 | Сообщение № 2

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

Ранг: Новичок

Сообщений: 27

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

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

Может не так понял задачу - берем последний лист, копируем, ставим в названии сегодняшнюю дату и в ячейку G2, в D2 ставим число из предыдущего дня + 1.
[vba]

Код

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

'Перемещение листа
'Копирование и перемещение
Dim kolvo As Variant
Dim i As Long
Dim list As Worksheet
StrData = CStr(Format(Now(), "dd/mm/yyyy"))

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

On Error Resume Next

'номер отчета
Sheets(Sheets.Count).Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = StrData

Range("G2").Select
ActiveCell = StrData
ActiveSheet.[d2] = ActiveSheet.[d2] + 1

End Sub

[/vba]

Ответить

den4ik2206

Дата: Среда, 14.06.2023, 12:02 | Сообщение № 3

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

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

Сообщений: 2

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

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

WowGun, спасибо примерно так и решил задачу. отработал от названия листа с текущей датой.

[vba]

Код

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

'Перемещение листа
'Копирование и перемещение
'Переименование
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)
ActiveSheet.[d2] = ActiveSheet.[d2] + 1

End Sub

[/vba]

Сообщение отредактировал Serge_007 - Среда, 14.06.2023, 14:04

Ответить

Страница 1 из 1
1