Здравствуйте. Нужно из листа "ВЗВЕШИВАНИЕ" скопировать строки, в которых ячейки в столбце G будут равны: или '1'!E4, тогда в таблицу лист '1', или '2'!E4, тогда в таблицу лист '2', или '3'!E4, тогда в таблицу лист '3' и т.д. Пробовал функциями ЕСЛИ, ВПР и ИНДЕКС, но это очень долго и трудоемко. Какими способами (макросами или функциями) можно это сделать.
Здравствуйте. Нужно из листа "ВЗВЕШИВАНИЕ" скопировать строки, в которых ячейки в столбце G будут равны: или '1'!E4, тогда в таблицу лист '1', или '2'!E4, тогда в таблицу лист '2', или '3'!E4, тогда в таблицу лист '3' и т.д. Пробовал функциями ЕСЛИ, ВПР и ИНДЕКС, но это очень долго и трудоемко. Какими способами (макросами или функциями) можно это сделать.amaksimus85
спасибо хороший варинт. но все равно придется вручную нажимать на фильтр. не на много шагов отличается от макроса сортировки и дальнейшего копирования строк в нужные листы...
спасибо хороший варинт. но все равно придется вручную нажимать на фильтр. не на много шагов отличается от макроса сортировки и дальнейшего копирования строк в нужные листы...amaksimus85
Сообщение отредактировал Serge_007 - Понедельник, 06.02.2023, 15:30
Несовсем ясно зачем попарное объединение строк в ваших бланках. Наверное чтобы усложнить жизнь при написании макросов.
[vba]
Код
Application.ScreenUpdating = False Dim c As Range Dim sh As Worksheet Dim ash As Worksheet Set ash = Sheets("ВЗВЕШИВАНИЕ") Set c = ash.Range("c6").Offset(1, 0) For Each sh In ThisWorkbook.Worksheets If sh.Name <> ash.Name Then sh.Range("a7:g65536").ClearContents End If Next ash.Select Do While c.Value <> "" For Each sh In ThisWorkbook.Worksheets If sh.Name <> ash.Name Then If sh.Range("e4").Value = c.Offset(0, 4).Value Then ash.Select ash.Range(c.Offset(0, -2), c.Offset(0, 4)).Select Selection.Copy sh.Activate sh.Range("a65536").End(xlUp).Offset(2, 0).Select ActiveSheet.Paste End If End If Next ash.Select Set c = c.Offset(1, 0) c.Select Loop Application.ScreenUpdating = True
[/vba]
Несовсем ясно зачем попарное объединение строк в ваших бланках. Наверное чтобы усложнить жизнь при написании макросов.
[vba]
Код
Application.ScreenUpdating = False Dim c As Range Dim sh As Worksheet Dim ash As Worksheet Set ash = Sheets("ВЗВЕШИВАНИЕ") Set c = ash.Range("c6").Offset(1, 0) For Each sh In ThisWorkbook.Worksheets If sh.Name <> ash.Name Then sh.Range("a7:g65536").ClearContents End If Next ash.Select Do While c.Value <> "" For Each sh In ThisWorkbook.Worksheets If sh.Name <> ash.Name Then If sh.Range("e4").Value = c.Offset(0, 4).Value Then ash.Select ash.Range(c.Offset(0, -2), c.Offset(0, 4)).Select Selection.Copy sh.Activate sh.Range("a65536").End(xlUp).Offset(2, 0).Select ActiveSheet.Paste End If End If Next ash.Select Set c = c.Offset(1, 0) c.Select Loop Application.ScreenUpdating = True
Несовсем ясно зачем попарное объединение строк в ваших бланках. Наверное чтобы усложнить жизнь при написании макросов.
Спасибо!Объединение нужно для другой таблицы, в которой для одной строки нужны разные показатели, в которую копирую данные строки. что ннужно изменить в Вашем макросе, чтобы подходил для обычных одинарных строк? еще раз спасибо!
Несовсем ясно зачем попарное объединение строк в ваших бланках. Наверное чтобы усложнить жизнь при написании макросов.
Спасибо!Объединение нужно для другой таблицы, в которой для одной строки нужны разные показатели, в которую копирую данные строки. что ннужно изменить в Вашем макросе, чтобы подходил для обычных одинарных строк? еще раз спасибо!amaksimus85
что ннужно изменить в Вашем макросе, чтобы подходил для обычных одинарных строк?
Лень переписывать. В текущем коде замените как указано в комментарии. [vba]
Код
Application.ScreenUpdating = False Dim c As Range Dim sh As Worksheet Dim ash As Worksheet Set ash = Sheets("ВЗВЕШИВАНИЕ") Set c = ash.Range("c6").Offset(1, 0) For Each sh In ThisWorkbook.Worksheets If sh.Name <> ash.Name Then sh.Range("a7:g65536").ClearContents End If Next ash.Select Do While c.Value <> "" For Each sh In ThisWorkbook.Worksheets If sh.Name <> ash.Name Then If sh.Range("e4").Value = c.Offset(0, 4).Value Then ash.Select ash.Range(c.Offset(0, -2), c.Offset(0, 4)).Select Selection.Copy sh.Activate sh.Range("a65536").End(xlUp).Offset(2, 0).Select ' заменить на sh.Range("a65536").End(xlUp).Offset(1, 0).Select если отменить объединение строк ActiveSheet.Paste End If End If Next ash.Select Set c = c.Offset(1, 0) c.Select Loop Application.ScreenUpdating = True
что ннужно изменить в Вашем макросе, чтобы подходил для обычных одинарных строк?
Лень переписывать. В текущем коде замените как указано в комментарии. [vba]
Код
Application.ScreenUpdating = False Dim c As Range Dim sh As Worksheet Dim ash As Worksheet Set ash = Sheets("ВЗВЕШИВАНИЕ") Set c = ash.Range("c6").Offset(1, 0) For Each sh In ThisWorkbook.Worksheets If sh.Name <> ash.Name Then sh.Range("a7:g65536").ClearContents End If Next ash.Select Do While c.Value <> "" For Each sh In ThisWorkbook.Worksheets If sh.Name <> ash.Name Then If sh.Range("e4").Value = c.Offset(0, 4).Value Then ash.Select ash.Range(c.Offset(0, -2), c.Offset(0, 4)).Select Selection.Copy sh.Activate sh.Range("a65536").End(xlUp).Offset(2, 0).Select ' заменить на sh.Range("a65536").End(xlUp).Offset(1, 0).Select если отменить объединение строк ActiveSheet.Paste End If End If Next ash.Select Set c = c.Offset(1, 0) c.Select Loop Application.ScreenUpdating = True
mgt, Здравствуйте. Спасибо еще раз за макрос. Он работает в книге для примера, но не работает в моей рабочей, где он и нужен. Может, у Вас найдется время глянуть? модуль3, copyweight
mgt, Здравствуйте. Спасибо еще раз за макрос. Он работает в книге для примера, но не работает в моей рабочей, где он и нужен. Может, у Вас найдется время глянуть? модуль3, copyweightamaksimus85
mgt, понял, почему не работает макрос , опубликованный выше,в другой книге.
Потому что в этой книге есть другие листы с другими таблицами, на которые макрос пытается скопировать строки. При этом пишет ошибку "часть обьединенных ячеек изменить невозможно"
Вопрос. Можно ли дать комнду макросу чтобы копировал строки в листы, которые в начале книги или в конце, или после конкретного листа ("ВЗВЕШИВАНИЕ)?
mgt, понял, почему не работает макрос , опубликованный выше,в другой книге.
Потому что в этой книге есть другие листы с другими таблицами, на которые макрос пытается скопировать строки. При этом пишет ошибку "часть обьединенных ячеек изменить невозможно"
Вопрос. Можно ли дать комнду макросу чтобы копировал строки в листы, которые в начале книги или в конце, или после конкретного листа ("ВЗВЕШИВАНИЕ)?amaksimus85
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
