Здравствуйте. Нужна помощь специалистов по экселю. Есть мастер таблица на Лист 1. В ней 10 столбцов. Надо автоматически отфильтровать ее по Фамилии (в некоторых ячейках 2 фамилии, но они тоже должны попадать в итоговую, так как один из исполнителей нам нужен). В результате хотелось бы получить таблицу как на листе "Результат". Написала макрос, но в нем ошибки есть: 1. Копируется вся строка, не знаю как сделать, чтобы копировался только массив столбцов от B до E. На основе столбцов H,I,J будут логически выставляться 0 или 1 в результирующую таблицу (0,2 и 0,3 на листе Результат) 2. Если 2 фамилии, то строка не копируется.
Макрос такой (кривенький, первый в жизни)
[vba]
Код
Sub Макрос Priznak = Application.InputBox("Укажите признак переноса строки", "Признак", "Фамилия") For Each iCell In Range("C2", [C2].End(xlDown)) 'цикл по всем ячейкам C2 и ниже If iCell = Priznak Then With Sheets("Итоговый") 'копируем на Итоговый iCell.EntireRow.Copy Destination:=.Cells(.Cells(Rows.Count, "С").End(xlUp).Row + 1, "С") End With End If Next iCell MsgBox "Строки содержащие " & Priznak & " в столбце С скопированы на другой лист!", vbInformation, "" End Sub
[/vba] Помогите, пожалуйста. Файл во вложении. Спасибо!
Здравствуйте. Нужна помощь специалистов по экселю. Есть мастер таблица на Лист 1. В ней 10 столбцов. Надо автоматически отфильтровать ее по Фамилии (в некоторых ячейках 2 фамилии, но они тоже должны попадать в итоговую, так как один из исполнителей нам нужен). В результате хотелось бы получить таблицу как на листе "Результат". Написала макрос, но в нем ошибки есть: 1. Копируется вся строка, не знаю как сделать, чтобы копировался только массив столбцов от B до E. На основе столбцов H,I,J будут логически выставляться 0 или 1 в результирующую таблицу (0,2 и 0,3 на листе Результат) 2. Если 2 фамилии, то строка не копируется.
Макрос такой (кривенький, первый в жизни)
[vba]
Код
Sub Макрос Priznak = Application.InputBox("Укажите признак переноса строки", "Признак", "Фамилия") For Each iCell In Range("C2", [C2].End(xlDown)) 'цикл по всем ячейкам C2 и ниже If iCell = Priznak Then With Sheets("Итоговый") 'копируем на Итоговый iCell.EntireRow.Copy Destination:=.Cells(.Cells(Rows.Count, "С").End(xlUp).Row + 1, "С") End With End If Next iCell MsgBox "Строки содержащие " & Priznak & " в столбце С скопированы на другой лист!", vbInformation, "" End Sub
[/vba] Помогите, пожалуйста. Файл во вложении. Спасибо!IStepanova
[/vba] Почитайте справку про Cells и Range. При использовании Cells нужно указывать номер строки и номер столбца, т.е не Cells(i, "c"), а Cells(i, 3) (i - номер строчки).
IStepanova, замените строчку копирования строки на [vba]
[/vba] Почитайте справку про Cells и Range. При использовании Cells нужно указывать номер строки и номер столбца, т.е не Cells(i, "c"), а Cells(i, 3) (i - номер строчки).Manyasha
Sub Макрос() Priznak = Application.InputBox("Укажите признак переноса строки", "Признак", "МО") For Each iCell In Range("c2", [c2].End(xlDown)) 'цикл по всем ячейкам c2 и ниже If iCell Like "*" & Priznak & "*" Then ' If iCell = Priznak Then With Sheets("Итоговый") 'копируем на Итоговый iCell.EntireRow.Cells(1).Offset(, 1).Resize(, 9).Copy Destination:=.Cells(.Cells(Rows.Count, "b").End(xlUp).Row + 2, "b") ' iCell.EntireRow.Copy Destination:=.Cells(.Cells(Rows.Count, "b").End(xlUp).Row + 2, "b") End With End If Next iCell MsgBox "Строки содержащие " & Priznak & " в столбце с скопированы на другой лист!", vbInformation, "" End Sub
[/vba]
Cells(i, "c") - синтаксис абсолютно верный. [vba]
Код
Sub Макрос() Priznak = Application.InputBox("Укажите признак переноса строки", "Признак", "МО") For Each iCell In Range("c2", [c2].End(xlDown)) 'цикл по всем ячейкам c2 и ниже If iCell Like "*" & Priznak & "*" Then ' If iCell = Priznak Then With Sheets("Итоговый") 'копируем на Итоговый iCell.EntireRow.Cells(1).Offset(, 1).Resize(, 9).Copy Destination:=.Cells(.Cells(Rows.Count, "b").End(xlUp).Row + 2, "b") ' iCell.EntireRow.Copy Destination:=.Cells(.Cells(Rows.Count, "b").End(xlUp).Row + 2, "b") End With End If Next iCell MsgBox "Строки содержащие " & Priznak & " в столбце с скопированы на другой лист!", vbInformation, "" End Sub