Перейти к основному содержанию

Как скопировать строки из нескольких листов на основе критериев на новый лист?

Предположим, у вас есть книга с тремя листами, которые имеют такое же форматирование, как показано на скриншоте ниже. Теперь вы хотите скопировать все строки из этих листов, столбец C которых содержит текст «Завершено», в новый лист. Как можно быстро и легко решить эту проблему, не копируя и не вставляя их вручную?

Скопируйте строки из нескольких листов на основе критериев в новый лист с кодом VBA


Скопируйте строки из нескольких листов на основе критериев в новый лист с кодом VBA

Следующий код VBA может помочь вам скопировать определенные строки со всех листов в книге на основе определенного условия в новый лист. Пожалуйста, сделайте так:

1. Удерживайте ALT + F11 , чтобы открыть Microsoft Visual Basic для приложений окно.

2. Нажмите Вставить > Модулии вставьте следующий код в окно модуля.

Код VBA: копирование строк с нескольких листов на основе критериев на новый лист

Public Sub CopyRows_ValuesAndNumberFormats()
Dim xWs As Worksheet
Dim xCWs As Worksheet
Dim xRg As Range
Dim xStrName As String
Dim xRStr As String
Dim xRRg As Range
Dim xC As Integer
On Error Resume Next
Application.DisplayAlerts = False
xStr = "Kutools for Excel"
xRStr = "Completed"
Set xCWs = ActiveWorkbook.Worksheets.Item(xStr)
If Not xCWs Is Nothing Then
    xCWs.Delete
End If
Set xCWs = ActiveWorkbook.Worksheets.Add
xCWs.Name = xStr
xC = 1
For Each xWs In ActiveWorkbook.Worksheets
    If xWs.Name <> xStr Then
        Set xRg = xWs.Range("C:C")
        Set xRg = Intersect(xRg, xWs.UsedRange)
        For Each xRRg In xRg
            If xRRg.Value = xRStr Then
               xRRg.EntireRow.Copy
               xCWs.Cells(xC, 1).PasteSpecial xlPasteValuesAndNumberFormats
               xC = xC + 1
            End If
        Next xRRg
    End If
Next xWs
Application.DisplayAlerts = True
End Sub

Внимание: В приведенном выше коде:

  • Текст "Заполненная" в этом xRStr = "Завершено" сценарий указывает конкретное условие, на основе которого вы хотите скопировать строки;
  • C: C В этом Установите xRg = xWs.Range ("C: C") скрипт указывает конкретный столбец, в котором находится условие.

3, Затем нажмите F5 ключ для запуска этого кода, и все строки с определенным условием были скопированы и вставлены на новый рабочий лист с именем Kutools for Excel в текущей книге. Смотрите скриншот:


Более относительные статьи с данными для извлечения или копирования:

  • Копирование данных на другой лист с помощью расширенного фильтра в Excel
  • Обычно мы можем быстро применить функцию расширенного фильтра для извлечения данных из необработанных данных на том же листе. Но иногда, когда вы пытаетесь скопировать отфильтрованный результат на другой рабочий лист, вы получаете следующее предупреждающее сообщение. В таком случае, как бы вы могли справиться с этой задачей в Excel?
  • Копировать строки, если столбец содержит определенный текст / значение в Excel
  • Предположим, вы хотите найти ячейки, содержащие определенный текст или значение в столбце, а затем скопировать всю строку, в которой находится найденная ячейка, как вы можете с этим справиться? Здесь я представлю несколько методов, чтобы определить, содержит ли столбец определенный текст или значение, а затем скопировать всю строку в Excel.

  • Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон...
  • Объединить ячейки / строки / столбцы и хранение данных; Разделить содержимое ячеек; Объедините повторяющиеся строки и сумму / среднее значение... Предотвращение дублирования ячеек; Сравнить диапазоны...
  • Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор ...
  • Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое ...
  • Избранные и быстро вставляйте формулы, Диапазоны, диаграммы и изображения; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма ...
  • Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии...
  • Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом ...
  • Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF...
  • Группировка сводной таблицы по номер недели, день недели и другое ... Показать разблокированные, заблокированные ячейки разными цветами; Выделите ячейки, у которых есть формула / имя...
вкладка kte 201905
  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
офисный дно
Comments (2)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hi,

thank you very much for the code. I have a question: the code runs smoothly on some of my sheets, but looks like enters an infinite loop in some other ones which makes excel crash. What could the reason be?
This comment was minimized by the moderator on the site
Hello there, thank you so much for the code above, it solved me a problem with a complex file; a solution I have been looking for a while now. Thank you..I have one question. How do I change the code so that it copies the rows but only from colum A to colum Q, so not Entire.Row?Thank you in advance and great work!
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations