Как скопировать строки и вставить их на другой лист на основе даты в Excel?
Предположим, у меня есть диапазон данных, и теперь я хочу скопировать все строки на основе определенной даты, а затем вставить их на другой лист. Есть ли у вас какие-нибудь хорошие идеи, как справиться с этой задачей в Excel?
Копирование строк и вставка их на другой лист на основе сегодняшней даты
Копирование строк и вставка их на другой лист, если дата больше сегодняшней
Копирование строк и вставка их на другой лист на основе сегодняшней даты
Если вам нужно скопировать строки, если дата соответствует сегодняшней, примените следующий код VBA:
1. Нажмите и удерживайте клавиши ALT + F11, чтобы открыть окно Microsoft Visual Basic for Applications.
2. Нажмите Вставить > Модуль и вставьте следующий код в окно Модуля.
Код VBA: Копирование и вставка строк на основе сегодняшней даты:
Sub CopyRow()
'Updateby Extendoffice
Dim xRgS As Range, xRgD As Range, xCell As Range
Dim I As Long, xCol As Long, J As Long
Dim xVal As Variant
On Error Resume Next
Set xRgS = Application.InputBox("Please select the date column:", "KuTools For Excel", Selection.Address, , , , , 8)
If xRgS Is Nothing Then Exit Sub
Set xRgD = Application.InputBox("Please select a destination cell:", "KuTools For Excel", , , , , , 8)
If xRgD Is Nothing Then Exit Sub
xCol = xRgS.Rows.Count
Set xRgS = xRgS(1)
Application.CutCopyMode = False
J = 0
For I = 1 To xCol
Set xCell = xRgS.Offset(I - 1, 0)
xVal = xCell.Value
If TypeName(xVal) = "Date" And (xVal <> "") And (xVal = Date) Then
xCell.EntireRow.Copy xRgD.Offset(J, 0)
J = J + 1
End If
Next
Application.CutCopyMode = True
End Sub
3. После вставки вышеуказанного кода нажмите клавишу F5, чтобы запустить этот код, и появится всплывающее окно с напоминанием выбрать столбец даты, на основе которого вы хотите копировать строки, см. скриншот:
4. Затем нажмите кнопку ОК, во втором всплывающем окне выберите ячейку на другом листе, куда вы хотите вывести результат, см. скриншот:
5. Затем нажмите кнопку ОК, теперь строки с сегодняшней датой будут вставлены на новый лист сразу же, см. скриншот:
Копирование строк и вставка их на другой лист, если дата больше сегодняшней
Чтобы скопировать и вставить строки, дата которых больше или равна сегодняшней, например, если дата равна или больше 5 дней от сегодняшней, то скопируйте и вставьте строки на другой лист.
Следующий код VBA может помочь вам:
1. Нажмите и удерживайте клавиши ALT + F11, чтобы открыть окно Microsoft Visual Basic for Applications.
2. Нажмите Вставить > Модуль и вставьте следующий код в окно Модуля.
Код VBA: Копирование и вставка строк, если дата больше сегодняшней:
Sub CopyRow()
'Updateby Extentoffice
Dim xRgS As Range, xRgD As Range, xCell As Range
Dim I As Long, xCol As Long, J As Long
Dim xVal As Variant
On Error Resume Next
Set xRgS = Application.InputBox("Please select the date column:", "KuTools For Excel", Selection.Address, , , , , 8)
If xRgS Is Nothing Then Exit Sub
Set xRgD = Application.InputBox("Please select a destination cell:", "KuTools For Excel", , , , , , 8)
If xRgD Is Nothing Then Exit Sub
xCol = xRgS.Rows.Count
Set xRgS = xRgS(1)
Application.CutCopyMode = False
J = 0
For I = 1 To xCol
Set xCell = xRgS.Offset(I - 1, 0)
xVal = xCell.Value
If TypeName(xVal) = "Date" And (xVal <> "") And (xVal >= Date And (xVal < Date + 5)) Then
xCell.EntireRow.Copy xRgD.Offset(J, 0)
J = J + 1
End If
Next
Application.CutCopyMode = True
End Sub
Примечание: В приведенном выше коде вы можете изменить критерии, такие как меньше сегодняшнего дня или количество дней, которые вам нужны, в скрипте If TypeName(xVal) = "Date" And (xVal <> "") And (xVal >= Date And (xVal < Date + 5)) Then.
3. Затем нажмите клавишу F5, чтобы запустить этот код, в появившемся окне выберите столбец данных, который вы хотите использовать, см. скриншот:
4. Затем нажмите кнопку ОК, во втором всплывающем окне выберите ячейку на другом листе, куда вы хотите вывести результат, см. скриншот:
5. Нажмите кнопку ОК, теперь строки, дата которых равна или больше 5 дней от сегодняшней, были скопированы и вставлены на новый лист, как показано на следующем скриншоте:
Лучшие инструменты для повышения продуктивности в Office
Повысьте свои навыки работы в Excel с помощью Kutools для Excel и ощутите эффективность на новом уровне. Kutools для Excel предлагает более300 расширенных функций для повышения производительности и экономии времени. Нажмите здесь, чтобы выбрать функцию, которая вам нужнее всего...
Office Tab добавляет вкладки в Office и делает вашу работу намного проще
- Включите режим вкладок для редактирования и чтения в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
- Открывайте и создавайте несколько документов во вкладках одного окна вместо новых отдельных окон.
- Увеличьте свою продуктивность на50% и уменьшите количество щелчков мышью на сотни ежедневно!
Все надстройки Kutools. Один установщик
Пакет Kutools for Office включает надстройки для Excel, Word, Outlook и PowerPoint, а также Office Tab Pro — идеально для команд, работающих в разных приложениях Office.





- Комплексный набор — надстройки для Excel, Word, Outlook и PowerPoint плюс Office Tab Pro
- Один установщик, одна лицензия — настройка занимает считанные минуты (MSI-совместимо)
- Совместная работа — максимальная эффективность между приложениями Office
- 30-дневная полнофункциональная пробная версия — без регистрации и кредитной карты
- Лучшее соотношение цены и качества — экономия по сравнению с покупкой отдельных надстроек