2_VBA_макросы_зем_налог

' Находит значение Земельный налог и создает отдельный лист со строками где нашел значение Земельный налог
Sub CopyRowsWithLandTax()
    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim lastRow As Long, lastCol As Long, i As Long, j As Long, destRow As Long
    Dim found As Boolean

    ' Используем активный лист как источник данных
    Set wsSource = ActiveSheet

    ' Добавляем новый лист для результатов
    Set wsDest = Sheets.Add
    wsDest.Name = "Земельный налог"

    ' Определяем последнюю строку и столбец на исходном листе
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    lastCol = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column

    ' Инициализируем номер строки для копирования
    destRow = 1

    ' Проходим по всем строкам активного листа
    For i = 1 To lastRow
        found = False
        ' Проверяем каждый столбец в строке
        For j = 1 To lastCol
            If InStr(1, wsSource.Cells(i, j).Value, "Земельный налог", vbTextCompare) > 0 Then
                found = True
                Exit For
            End If
        Next j

        ' Копируем строку, если найдено соответствие
        If found Then
            wsSource.Rows(i).Copy Destination:=wsDest.Rows(destRow)
            destRow = destRow + 1
        End If
    Next i
End Sub

---------------
' Выделяет цветом строки если нашел значение в столбце D "В процессе банкротства","В процессе ликвидации","Ликвидировано"
Sub HighlightRows()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim cellValue As String

    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row

    ' Проходим по столбцу D
    For i = 1 To lastRow
        cellValue = ws.Cells(i, 4).Value ' 4 - это столбец D

        ' Проверяем, соответствует ли значение одному из указанных
        If cellValue = "В процессе банкротства" Or cellValue = "В процессе ликвидации" Or cellValue = "Ликвидировано" Then
            ' Если да, подсвечиваем строку красным
            With ws.Rows(i).Interior
                .Color = RGB(208, 115, 116) ' Красный оттенок цвет
            End With
        End If
    Next i
End Sub