Excel VBA копирует значения, соответствующие критериям, в конкретную ячейку

Question

Я пытался создать список дел в Excel.Я решил написать макрос, который проверяет конкретные условия, и, если он встречается, копирует элемент to do.

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

• Копирует правильно, но я не уверен, как изменить строку с помощью .End(xlUp), чтобы вставить в определенную ячейку I20, и заполнить вниз каждым элементом.
• при вставкеперезаписать существующее содержимое в ячейках (поэтому каждый день, когда я нажимаю кнопку обновления, оно перезаписывает предыдущие дни)

Спасибо за помощь,

Sub today()
Dim StartDate As Long
Dim EndDate As Long

StartDate = DateSerial(Year(Date), Month(Date), Day(Date))
EndDate = DateSerial(Year(Date), Month(Date), Day(Date) + 6)

For Row = 1 To 100

    If Worksheets("sheet1").Cells(Row, 6).Value >= StartDate And Worksheets("sheet1").Cells(Row, 6).Value <= EndDate And Worksheets("sheet1").Cells(Row, 4).Value <> "Complete" Then

        Worksheets("sheet1").Cells(Row, 2).Copy

        Worksheets("Sheet1").Cells(Rows.Count, "I").End(xlUp).Offset(1, 0).PasteSpecial

        ActiveSheet.Paste
        Application.CutCopyMode = False
    End If

    Next Row

End Sub

Answer 1

Вместо

   Worksheets("sheet1").Cells(Row, 2).Copy

   Worksheets("Sheet1").Cells(Rows.Count, "I").End(xlUp).Offset(1, 0).PasteSpecial

   ActiveSheet.Paste
   Application.CutCopyMode = False

Вы можете попробовать

Worksheets("Sheet1").Cells(Rows.count,"I").End(xlup).offset(1,0).value = worksheets("Sheet1").Cells(Row,2).Value

Я думаю, что вы ссылаетесь на правую ячейку (последняя ячейка + 1 строка), но ActiveSheet.Paste портитэто до.Рядом с этим копирование / вставка выполняется медленнее, чем просто получение значения.

РЕДАКТИРОВАТЬ: Если вы хотите начать с I20, но I19 не заполнен, вы можете сначала определить строку перед установкой значения:

Dim rowNum as Long
rowNum = application.worksheetfunction.max(20,Worksheets("Sheet1").Cells(Rows.count,"I").End(xlup).offset(1,0).Row)
Worksheets("Sheet1").Cells(rowNum,"I").Value = Worksheets("Sheet1").Cells(Row,2).Value