excel - Excel VBA将满足条件的值复制到特定单元格

Question

我一直在尝试在excel中建立一个待办事项列表。我决定编写一个宏来检查特定条件，如果满足则复制待办事项。

我是一个 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

标签： excelvba

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