Перейти к содержимому

Исследуйте новую бесплатную версию Kutools для Outlook уже сегодня!

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

Author: Xiaoyang Last Modified: 2025-06-05

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

sample data 1 ample data 2 ample data 3

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

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

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

1. Нажмите и удерживайте клавиши ALT + F11, чтобы открыть окно Microsoft Visual Basic for Applications.

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 в этом Set xRg = xWs.Range("C:C") скрипте указывает конкретный столбец, где находится условие.

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

vba code to copy rows from multiple worksheets based on criteria

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

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

Лучшие инструменты для повышения производительности Office

Kutools для Excel решает большинство ваших проблем и увеличивает вашу продуктивность на 80%

  • Супер строка формул (легкое редактирование нескольких строк текста и формул); Режим чтения (удобное чтение и редактирование большого количества ячеек); Вставка в отфильтрованный диапазон...
  • Объединение ячеек/строк/столбцов с сохранением данных; Разделение содержимого ячеек; Объединение дублирующихся строк с подсчетом суммы/среднего значения... Предотвращение дублирования ячеек; Сравнение диапазонов...
  • Выбор дублирующихся или уникальных строк; Выбор пустых строк (все ячейки пустые); Супер поиск и нечеткий поиск во многих книгах; Случайный выбор...
  • Точное копирование нескольких ячеек без изменения ссылок на формулы; Автоматическое создание ссылок на несколько листов; Вставка маркеров, флажков и многое другое...
  • Избранные и быстрая вставка формул, диапазонов, диаграмм и изображений; Шифрование ячеек с паролем; Создание списка рассылки и отправка электронных писем...
  • Извлечение текста, добавление текста, удаление по позиции, удаление пробелов; Создание и печать статистики страниц; Преобразование между содержимым ячеек и комментариями...
  • Супер фильтр (сохранение и применение схем фильтрации к другим листам); Расширенная сортировка по месяцу/неделе/дню, частоте и другим параметрам; Специальный фильтр по жирному шрифту, курсиву...
  • Объединение книг и листов; Объединение таблиц на основе ключевых столбцов; Разделение данных на несколько листов; Пакетное преобразование xls, xlsx и PDF...
  • Группировка сводной таблицы по номеру недели, дню недели и другим параметрам... Отображение разблокированных, заблокированных ячеек разными цветами; Выделение ячеек, содержащих формулы/имена...
kte tab 201905
  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
  • Открывайте и создавайте несколько документов в новых вкладках одного окна, а не в новых окнах.
  • Увеличивает вашу продуктивность на 50% и экономит сотни кликов мышью каждый день!
officetab bottom