Private Sub переместитьвверх_Click()

    
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim endRow As Long
    Dim selectedIndex As Long
    
    selectedIndex = список.ListIndex
    If selectedIndex <= 0 Then Exit Sub
    

    For i = 1 To Склад.Cells(Rows.count, "A").End(xlUp).row
        If Склад.Cells(i, "A") = ">" Then
            selectedIndex = selectedIndex - 1
            If selectedIndex < 0 Then Exit For
        End If
    Next i
    

    If i > 1 Then

        endRow = i + 1
        Do While endRow <= Склад.Cells(Rows.count, "A").End(xlUp).row And Склад.Cells(endRow, "A") <> ">"
            endRow = endRow + 1
        Loop
        endRow = endRow - 1
        

        j = i - 1
        Do While j > 1 And Склад.Cells(j, "A") <> ">"
            j = j - 1
        Loop
        

        For k = i To endRow
            Склад.Rows(k).Cut
            Склад.Rows(j).Insert Shift:=xlDown
            j = j + 1
        Next k
    End If


    UpdateList
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    Application.EnableEvents = False ' Отключаем обработку событий
    For Each cell In Target
If Target.Cells.Count = 1 Then
            If Not Intersect(cell, Range("F2:F10000")) Is Nothing Then ' Должники
            
                If Target.Column = 6 And (Target.Value = "Наличка" Or Target.Value = "Карта") And cell.Offset(0, -5) > 0 Then
                    Target.CurrentRegion.Rows(Target.Row).Cut
                    Cells(Rows.Count, 2).End(xlUp).Offset(1, -1).Select
                    ActiveCell.Insert Shift:=xlDown
                    cell.Offset(0, -3).Value = Time
                    cell.Offset(0, -4).Value = Date
                    cell.Offset(0, -5).Value = ""
                Else
                    Dim PosLedN As Long
                    Dim ids As Long
                    PosLedN = Cells(Rows.Count, "F").End(xlUp).Row
                    For ids = PosLedN To 2 Step -1
                        If Cells(ids, "F") = "Долг" Then
                            Cells(ids, "A").Value = ids
                        Else
                            Cells(ids, "A").Value = ""
                        End If
                    Next ids
                End If
            End If
        End If
    next cell
End Sub

Private Sub Workbook_Open()
    If Day(Date) < 5 Then
        If SheetExist(ThisWorkbook.Name, Format(Date - 5, "MM.YYYY")) Then
        Else
            Application.Run "Лист4" & "." & "DelStariyMechyac"
        End If
    End If

End Sub

Function SheetExist(WbName As String, ShName As String) As Boolean
Dim mySheet As Worksheet
    For Each mySheet In Workbooks(WbName).Sheets
        If mySheet.Name = ShName Then
            SheetExist = True
            Exit Function
        End If
    Next
End Function

Private Sub Workbook_Open()
   
    Dim Дата As Date
    Dim lr As Long, i As Long
   
   
    ' Отключение монитора, чтобы ускорить макрос.
    Application.ScreenUpdating = False
   
    '1. Здесь укажите количество дней.
        ' Более 30 дней.
    tmpdat = Date - 30
   
    '2. Поиск последней строки в столбце B.
        ' End не ищет в скрытых строках.
    lr = Cells(Rows.Count, "B").End(xlUp).Row
   
    '3. Удаление строк.
    For i = lr To 1 Step -1
        If Cells(i, "B").Value < tmpdat Then
            Rows(i).Delete
        End If
    Next i
   
    '4. Включение монитора.
    Application.ScreenUpdating = True
   
End Sub