Nic70y, Класс. спасибо но с листами есть проблема, то что они удаляются, у меня еще есть лист. для справки, при сформировать, то удаляется этот лист:(
Nic70y, Класс. спасибо но с листами есть проблема, то что они удаляются, у меня еще есть лист. для справки, при сформировать, то удаляется этот лист:( flywithme1299
flywithme1299, вот здесь If u.Index > 1 Then u.Delete удаляются листы которые правее первого, если ваш лист для справки второй, то поставьте > 2, если нет нужно смотреть имена листов.
flywithme1299, вот здесь If u.Index > 1 Then u.Delete удаляются листы которые правее первого, если ваш лист для справки второй, то поставьте > 2, если нет нужно смотреть имена листов.Nic70y
Sub A_1() Application.ScreenUpdating = False 'удаляем листы Application.DisplayAlerts = False For Each u In ThisWorkbook.Sheets x = Sheets.Count If u.Index > 1 And u.Index < x Then u.Delete Next Application.DisplayAlerts = True 'проходимся по фио a = Cells(Rows.Count, "j").End(xlUp).Row For b = 2 To a c = Sheets(1).Range("j" & b).Value 'фио d = Application.Match(c, Sheets(1).Range("j1:j" & b), 0) 'ищем первую строку с фио If b = d Then 'если фио встречается вперые Sheets.Add After:=Sheets(Sheets.Count - 1) 'создаем лист Sheets(Sheets.Count - 1).Name = c 'назовем его = фио 'копируем шапку.................................... Sheets(1).Range("a1:b1").Copy Sheets(c).Range("a1") Sheets(1).Range("d1:i1").Copy Sheets(c).Range("c1") End If 'копируем данные e = Sheets(c).Cells(Rows.Count, "a").End(xlUp).Row + 1 'строка вставки Sheets(c).Range("a" & e) = Sheets(1).Cells(b + 1, "a").End(xlUp).Value Sheets(c).Range("b" & e) = Sheets(1).Cells(b + 1, "b").End(xlUp).Value Sheets(c).Range("c" & e & ":h" & e) = Sheets(1).Range("d" & b & ":i" & b).Value Next Application.ScreenUpdating = True End Sub
[/vba]
[vba]
Код
Sub A_1() Application.ScreenUpdating = False 'удаляем листы Application.DisplayAlerts = False For Each u In ThisWorkbook.Sheets x = Sheets.Count If u.Index > 1 And u.Index < x Then u.Delete Next Application.DisplayAlerts = True 'проходимся по фио a = Cells(Rows.Count, "j").End(xlUp).Row For b = 2 To a c = Sheets(1).Range("j" & b).Value 'фио d = Application.Match(c, Sheets(1).Range("j1:j" & b), 0) 'ищем первую строку с фио If b = d Then 'если фио встречается вперые Sheets.Add After:=Sheets(Sheets.Count - 1) 'создаем лист Sheets(Sheets.Count - 1).Name = c 'назовем его = фио 'копируем шапку.................................... Sheets(1).Range("a1:b1").Copy Sheets(c).Range("a1") Sheets(1).Range("d1:i1").Copy Sheets(c).Range("c1") End If 'копируем данные e = Sheets(c).Cells(Rows.Count, "a").End(xlUp).Row + 1 'строка вставки Sheets(c).Range("a" & e) = Sheets(1).Cells(b + 1, "a").End(xlUp).Value Sheets(c).Range("b" & e) = Sheets(1).Cells(b + 1, "b").End(xlUp).Value Sheets(c).Range("c" & e & ":h" & e) = Sheets(1).Range("d" & b & ":i" & b).Value Next Application.ScreenUpdating = True End Sub
Nic70y, Все же этот код не подошел, работал над старым кодом, его вроде приспособил. еще есть вопрос. как сделать так чтобы краткая информация подтягивались на первую страницу с других листов? То есть, есть столбец "Краткая информация" люди ответственные за свой лист заполняют по уже ранее заполненной строке краткую информацию, и она подтягивается на первый лист, то есть задачу на оборот, но только одна ячейка
Nic70y, Все же этот код не подошел, работал над старым кодом, его вроде приспособил. еще есть вопрос. как сделать так чтобы краткая информация подтягивались на первую страницу с других листов? То есть, есть столбец "Краткая информация" люди ответственные за свой лист заполняют по уже ранее заполненной строке краткую информацию, и она подтягивается на первый лист, то есть задачу на оборот, но только одна ячейкаflywithme1299
Nic70y, Как еще можно сделать. чтобы если поменять Ответственного, допустим Волкова поменяли на Петрова, чтобы если у Волкова одна строка была заполнена, то у Волкова удалилось, а у Петрова добавилось?
Nic70y, Как еще можно сделать. чтобы если поменять Ответственного, допустим Волкова поменяли на Петрова, чтобы если у Волкова одна строка была заполнена, то у Волкова удалилось, а у Петрова добавилось?flywithme1299
Сообщение отредактировал flywithme1299 - Четверг, 27.04.2023, 11:20
Nic70y, да, там просто дополнительно разные колонки и много еще дополнительной информации, которая не нужно удалять, вот и пришлось работать с первым кодом, просто изначально дезинформировал Вас, а тут после каждого нажатия кнопки. то происходит удаление данных. которые просто ручками прописали
Nic70y, да, там просто дополнительно разные колонки и много еще дополнительной информации, которая не нужно удалять, вот и пришлось работать с первым кодом, просто изначально дезинформировал Вас, а тут после каждого нажатия кнопки. то происходит удаление данных. которые просто ручками прописалиflywithme1299