Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Макрос для создания листа с зафиксированной текущей датой - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Макрос для создания листа с зафиксированной текущей датой
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
 
Ответить
СообщениеЗдравствуйте.
Написал макрос чтобы можно было копировать предыдущий лист с изменением даты
Проблема в том что копирует теперь по 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]

Автор - den4ik2206
Дата добавления - 10.06.2023 в 19:11
WowGun Дата: Суббота, 10.06.2023, 20:40 | Сообщение № 2
Группа: Проверенные
Ранг: Новичок
Сообщений: 37
Репутация: 9 ±
Замечаний: 0% ±

Excel 2016
Может не так понял задачу - берем последний лист, копируем, ставим в названии сегодняшнюю дату и в ячейку 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]


УЧИТЕСЬ ... спрашивать.
 
Ответить
СообщениеМожет не так понял задачу - берем последний лист, копируем, ставим в названии сегодняшнюю дату и в ячейку 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]

Автор - WowGun
Дата добавления - 10.06.2023 в 20:40
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
 
Ответить
Сообщение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]

Автор - den4ik2206
Дата добавления - 14.06.2023 в 12:02
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!