Возврат на лист предыдущего дня

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

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

Возврат на лист предыдущего дня (Макросы/Sub)

dmtgrs

Дата: Вторник, 25.12.2018, 08:45 | Сообщение № 1

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

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

Сообщений: 30

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

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

Excel 2016

Здравствуйте.
Помогите пожалуйста. Мне нужно чтобы макрос создавал лист с названием текущей даты и копировал определенные ячейки с листа с предыдущей датой.
Т.е. сегодня я нажимаю на макрос, он создает новый лист у которого название 25/12/2018 и затем он копирует определенные ячейки с листа 24/12/2018.
Как создать лист и переименовать его в текущую дату я понял, но затем макрос обращается к листу с конкретным названием, а нужно чтобы он обращался к листу со вчерашней датой.

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

Сообщение отредактировал dmtgrs - Вторник, 25.12.2018, 08:46

Ответить

sboy

Дата: Вторник, 25.12.2018, 09:56 | Сообщение № 2

Группа: Друзья

Ранг: Участник клуба

Сообщений: 2566

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

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

Excel 2010

Добрый день.
Поправил немного
[vba]

Код

Sub НовыйДень()
'
' НовыйДень Макрос
'

'
    d = Date
    With Sheets((d - 1) & ""): arr = Range(.Cells(3, 8), .Cells(3, 8).End(xlDown)): End With
    Sheets.Copy After:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = Date 'Format(Now, "yyyy/mm/dd")
            Range("D3:G" & .Cells(.Rows.Count, 7).End(xlUp).Row).ClearContents
            .Cells(3, 4).Resize(UBound(arr), 1) = arr
        End With
End Sub

[/vba]

К сообщению приложен файл: 0104676.xlsb (42.5 Kb)

Яндекс: 410016850021169

Ответить

_Boroda_

Дата: Вторник, 25.12.2018, 13:21 | Сообщение № 3

Группа: Админы

Ранг: Местный житель

Сообщений: 16718

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

Замечаний: ±

2003; 2007; 2010; 2013 RUS

dmtgrs, Вы каждый-каждый день работаете? Выходные и праздники тоже?
Предлагаю такой вариант (заодно проваряет наличие сегодняшнего листа)
[vba]

Код

Sub tt()
    On Error Resume Next
    aaa = Sheets(Date & "").Cells(1).Value
    If Err = 0 Then
        MsgBox "Лист ''" & Date & "'' уже есть"
        Exit Sub
    End If
    On Error GoTo 0
    Application.ScreenUpdating = 0
    Application.Calculation = 3
    Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
    With ActiveSheet
        .Name = Date
        r1_ = .Cells(.Rows.Count, 1).End(3).Row
        .Range("D3:D" & r1_) = .Range("H3:H" & r1_).Value
        .Range("E3:G" & r1_).ClearContents
    End With
    Application.Calculation = 1
    Application.ScreenUpdating = 1
End Sub

[/vba]

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

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

dmtgrs

Дата: Вторник, 25.12.2018, 14:40 | Сообщение № 4

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

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

Сообщений: 30

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

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

Excel 2016

Класс!!! Спасибо огромное!!! я тоже тут намучился, но что-то получилось, не знаю на сколько правильно)) То что у вас вылезает сообщение, для меня это вообще верх мастерства!!!

У меня так получилось, попробую разобраться как у вас так хитро сообщение вылетает
[vba]

Код

Sheets.Add After:=ActiveSheet
ActiveSheet.Name = Format(Now, "dd/mm/yyyy")
ActiveSheet.Previous.Select
Cells.Select
Selection.Copy
ActiveSheet.Next.Select
ActiveSheet.Paste
Range("D3:G15000").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveSheet.Previous.Select
Range("H3:H15000").Select
Selection.Copy
ActiveSheet.Next.Select
Range("D3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Rows("1:3").Select
Range("A3").Activate
ActiveWindow.FreezePanes = True
Range("A2").Select
Selection.AutoFilter
Range("D1").Select
ActiveCell.Value = Format(Now, "dd.mm.yyyy")

End Sub

[/vba]

Сообщение отредактировал dmtgrs - Вторник, 25.12.2018, 14:56

Ответить

_Boroda_

Дата: Вторник, 25.12.2018, 15:09 | Сообщение № 5

Группа: Админы

Ранг: Местный житель

Сообщений: 16718

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

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Цитата dmtgrs, 25.12.2018 в 14:40, в сообщении № 4 ()

как у вас так хитро сообщение вылетает

Очень просто - обращаемся к первой ячейке листа с сегодняшней датой. Если ошибки нет, то это означает, что такой лист уже есть, тогда пишем ругалку и выходим из макроса

Ответить

Возврат на лист предыдущего дня (Макросы/Sub)

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