Если выполняется 2 условия произвести копирование ячеек

[MASRUB]

Хотелось бы вот что: Если в столбце N встречается пустая ячейка, и рядом с ней в ячейке M не пусто,(пример таких ячеек выделил желтым) производить копирование на отдельный лист, что бы отразить данные в виде таблицы (которая приведена ниже в документе). Вообще в идеале я хочу сделать, чтобы из одного фала брались данные удовлетворяющие условиям (как желтая выделенная ячейка) в файле может быть около 20 листов, и все эти данные собирались в одну таблицу отдельного файла. В принципе, что касается проверки на пустые непустые ячейки я более менее разобрался, а вот что касается копирования, никак не могу понять как это реализуется в виде формулы. Похоже что никак, нужно писать макрос. Подскажите пожалуйста как реализовать проверку на два вышеописанных условия, и копирование ячеек в виде макроса

[doober]

Макрос Start

[MASRUB]

Большое спасибо!!!

[АННА-ЕАО]

Всем привет. Помогите, пожалуйста.
Проблема такая же как и в теме.
Я проверяю отчеты накладывая формулы в столбцах с СС по СМ (которые сделала сама, конечно возможно далеко до идеала но главное что работают), каждый столбец соответствует определенному типу ошибок если формулы отображают результат. После чего я с помощью фильтра копирую в ручную все данные строки по каждому из столбцов по очереди на отдельный лист «ОШИБКИ» и вставляю строку с тексом ошибки. Мне бы очень, очень хотелось бы автоматизировать свою работу.

На форуме нашла много тем, но на мой взгляд для меня более менее подходит вариант из темы http://programmersforum.ru/showthrea...E2%E0%ED%E8%E5 предложенный VictorM (25.11.2010, 19:25) или вариант который предложил doober в данной теме. Попыталась, данные макросы переделать под себя, но у меня не получается .

Помогите, пожалуйста. Мне нужно примерно так: 1. лист должен создаваться не в новой книге, а в этой же. 2. Копировать всю строку с графы А по графу AL, если ячейка (соответственно этой строки) не пустая в графе СС, потом повторить поиск также с графами CD, CF, CG, CH, CI, CJ, CM. 3. Чтоб при нахождении данного условия, например в графе СС, копировались не только строки, но и текст ошибки. Текс ошибки находится в ячейках «1» соответственно графам, т.е. для графы СС в ячейки СС1 и т.д.

Сам отчет и результат, что должно получиться приложила в примере.
ЗЫ. у нас эксель 2007, но отчеты присылают в 2003.

[nilem]

Как-то так, наверное:

Sub ertert()
Dim ErrList(), i&, j&, rng As Range: Application.ScreenUpdating = False
ErrList = Array(81, 82, 84, 85, 86, 87, 88, 91)    'СС, потом повторить поиск также с графами CD, CF, CG, CH, CI, CJ, CM)

Set rng = Range("A8:CM" & Cells(Rows.Count, 1).End(xlUp).Row)
rng.AutoFilter: j = 1

With Sheets("ОШИБКИ")
    .UsedRange.Clear
    For i = 0 To UBound(ErrList)
        rng.AutoFilter Field:=ErrList(i), Criteria1:="<>"
        .Cells(j, 1).Value = Cells(1, ErrList(i)).Value
        ActiveSheet.AutoFilter.Range.Resize(, 38).SpecialCells(xlVisible).Copy .Cells(j + 1, 1)
        rng.AutoFilter Field:=ErrList(i)
        j = .Cells(Rows.Count, 2).End(xlUp).Row + 2
    Next i
    .Activate
End With

rng.AutoFilter: Application.ScreenUpdating = True
End Sub

Запускаем с активного листа "170".

[АННА-ЕАО]

nilem СПАСИБО ОГРОМНОЕ. Это то, что нужно.
Попробовала на других отчетах – работает.

Только при отсутствии условий почему то все равно выводит текст ошибки и «шапку» (строка A4:AL4). Желательно что бы если совпадений не найдено по конкретной графе то и выводить совсем ни чего не надо по данной графе. Как это исправить?

И ещё, подскажите , что нужно изменить в Вашем макросе, чтобы:
1. Если условие выполняется то копировалась всегда шапка отчета с А4:А8 по AL4:AL8.
2. Что бы лист «ОШИБКИ» создавался сам автоматически, потом в него вносились данные.
3. Чтобы текст с ошибками (содержащейся в 1 ячейках столбцов) выводился всегда в определенном формате и строка заливалась цветом (например: желтым, шрифт черный, жирный, курсив, размер 12).
т.е. в итоге максимально приблизить итог к моему прикрепленному примеру в листе "ошибки".

[АННА-ЕАО]

nilem При выполнении макроса почему то слетают (удаляются) фильтры на основном листе, это как то можно поправить?

[nilem]

Ну вот, пробуйте так:

Sub ertert()
Dim ErrList(), i&, j&, rng As Range, shapka As Range, rf As Range, wsh As Worksheet

With Application: .ScreenUpdating = 0: .DisplayAlerts = 0: End With
ErrList = Array(81, 82, 84, 85, 86, 87, 88, 91)    'СС, потом повторить поиск также с графами CD, CF, CG, CH, CI, CJ, CM)

Set wsh = ActiveSheet: Set shapka = Range("A4:AL7")
Set rng = Range("A8:CM" & Cells(Rows.Count, 1).End(xlUp).Row)
rng.AutoFilter: j = 1

On Error Resume Next
Sheets("ОШИБКИ").Delete
On Error GoTo 0

With Sheets.Add
    For i = 1 To shapka.Columns.Count
        Columns(i).ColumnWidth = wsh.Columns(i).ColumnWidth
    Next

    For i = 0 To UBound(ErrList)
        rng.AutoFilter Field:=ErrList(i), Criteria1:="<>"
        Set rf = wsh.AutoFilter.Range.Resize(, 38).SpecialCells(xlVisible)
        If rf.Cells.Count > 38 Then
            With Cells(j, 1)
                .Value = wsh.Cells(1, ErrList(i)).Value
                With .Font: .Bold = True: .Italic = True: .Size = 12: End With
                .Resize(, 26).Interior.Color = vbYellow
                shapka.Copy .Offset(1)
            End With
            rf.Copy .Cells(j + 5, 1)
        End If
        rng.AutoFilter Field:=ErrList(i)
        j = .Cells(Rows.Count, 2).End(xlUp).Row + 2
    Next i
    .Name = "ОШИБКИ"
End With

'rng.AutoFilter
With Application: .ScreenUpdating = 1: .DisplayAlerts = 1: End With
End Sub

Кошмар какой-то

[АННА-ЕАО]

Уважаемый nilem !!! ОГРОМНОЕ СПАСИБО! Дай Бог Вам здоровья! Какое счастье все работает!!!

А почему "Кашмар какой то"?

[nilem]

Сообщение от АННА-ЕАО

...А почему "Кашмар какой то"?

Слишком длинный код, мне такие не нравятся.
Ну, главное, чтобы работал как нужно