Excel VBA按钮可使用日期条件将数据从一个单元格粘贴到另一个单元格

Question

VBA有一些新功能。 我花了整整4天的时间试图弄清楚这一点，并尝试使用代码，终于可以寻求帮助了。

我要执行的操作的要点是使用一个按钮，单击该按钮将获取已生成的数据，并将其放在单元格L11中。 数据流的方式应该是一个月中的一天。 在L11中输入数据时，日期会更改每个条目。 因此，当我按下按钮时，我想让代码说-基于L8单元格中的日期（已生成），获取L11中的数据，并将其剪切并粘贴到该日期的Sheet2和列下。

我建立了以下代码，将数据从L11移动到工作表2单元格A2，然后将数据添加到工作表2的下一行（如果已有数据），但是为了使我想做的更快，我希望想要让代码知道L8中的日期，并在sheet2的列中找到该日期并将其粘贴在该日期下，同时从sheet1删除复制的数据：

Sub copypastetosheets2()

    For Each cell In Range("L8:L8")
    If cell.Value = "Monday, April 15" Then
        Range("L11:L11").Select
        Selection.Copy
        Sheets("sheet2").Select
        Range("A2").Select
        ActiveSheet.Paste
        Sheets("sheet1").Select
        Range("L11").Select
        Application.CutCopyMode = False
        Sheets("sheet2").Select
        Range("A2").Select
        Selection.Insert shift:=xlDown, copyorigin:=xlFormatFromLeftOrAbove
        Sheets("sheet1").Select
        Range("L11").Select

我还在不同的按钮上使用了此代码，该按钮可以工作并且可以执行我想要的操作，但是它仍然无法识别日期并将其放在其他列中：

Sub copypastetosheets()
Sheets("sheet1").Range("L11").Copy


With Sheets("April 15").Range("A" & Rows.Count).End(xlUp).Offset(1)
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteValues
    Worksheets("sheet1").Range("L11:L20").ClearContents
End With

End Sub

不要介意Sheets（“ April 15”）....我在测试时正在使用它。 这段代码很好用，但是唯一让我退缩的是日期的识别。 如果它知道将日期视为更改变量，然后根据该特定日期将来自L11的数据按照该日期粘贴到Sheet1上30或31列中的1列下，那么我现在就可以完成：)

任何帮助或指导，我们将不胜感激。 谢谢。

戴夫

Answer 1

好的，根据您告诉我的内容，这是一个非常基本的方法，对于日期，请使用Month day 。 例如L8 = April 3 。

Sheet2
April 1   April 2   April 3   April 4   April 5   ...
                    Data is
                    copied
                    here

我希望我能正确理解你。 这将在sheet2中找到匹配的日期，将数据复制过来并删除L8中的数据。

Option Explicit

Dim x As Integer

Sub Button1_Click()

x = 1

'this will find the column that matches the date and stores that as the copy location.
While Sheets("Sheet2").Cells(1, x).Value <> Sheets("Sheet1").Range("L8")
    x = x + 1
Wend


'this portion copies the data to the designated coordinates found by the first portion and delete the information from L8 and L11.
Sheets("Sheet2").Cells(2, x).Value = Sheets("Sheet1").Range("L11").Value
Sheets("Sheet1").Range("L8").Value = ""


End Sub

由于L11中包含公式，因此您不想删除该单元格。 更改公式为： =IF(L8 <> "", VLOOKUP(K8,A28:B58,2,FALSE), "")

只要L8中没有数据，此公式将使L11显得空白。