如何根据月份检查单元格的范围/列并复制它们

所以基本上，我想要做的是这样的：

------A--------B-------C-------D------ 1 Date Weight Misc ID* 2 2014-06-12 210 445556 3 2014-07-13 150 546456 4 2014-08-14 265 546456 5 2014-09-15 655 655654 6 2014-10-16 87 546656 7 2014-10-17 1552 545488 8 2014-11-18 225 546545 

我有一个button，我希望它运行一个macros来检查列A中的date是否在当前月份。 我试过使用

 Month(Date) 

但它会检查整个date，而不是仅在一个月。

如果colmumn A中单元格的月份等于当前月份，我希望它复制对应于该特定单元格的整行信息。 例如：当前月份是十一月份，我希望它复制A8 + B8 + C8 + D8，然后将这些信息粘贴到一个完全不同的工作簿中。

请记住，我完全是VBA的新手，但这是我到目前为止：

 Sub dat() Dim rng As Range Dim dat As Date dat = Month(Date) For Each rng In Range("A2:A100") If rng.Value = dat Then Range("???").Copy Range("A1").PasteSpecial End If Next End Sub 

没有真正发生。 如果我将其更改为dat=Date那么它只能在这个特定的日子里工作，并且需要永远运行1000个单元格。

我想如果我可以使用Cells(Rows.Count, "A").End(xlUp).Value = Month(Date)莫名其妙。 这甚至有可能吗？

编辑：要粘贴在不同的工作簿中，我使用以下命令：

 Dim wb As Workbook Set wb = Workbooks.Open("C:\Users\....DOCUMENT.xlsm") 

然后粘贴：

 wb.Sheets("Sheet1").Range("A" & NextDest & ":F" & NextDest).PasteSpecial 

Answer 1

只需将“目标表”更改为要复制到的表单的名称即可。

 Sub dat() Dim LastRow As Long Dim CurRow As Long Dim NextDest As Long Dim ws As Worksheet Set ws = Sheets("SOURCE SHEET") LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row For CurRow = 2 To LastRow If IsDate(ws.Range("A" & CurRow).Value) = True Then If Month(ws.Range("A" & CurRow).Value) = Month(Date) Then ws.Range("A" & CurRow & ":D" & CurRow).Copy NextDest = Sheets("DESTINATION SHEET").Range("A" & Rows.Count).End(xlUp).Row + 1 Sheets("DESTINATION SHEET").Range("A" & NextDest & ":D" & NextDest).PasteSpecial Else End If Else ws.Cells(CurRow, 1).Interior.Color = RGB(255,0,0) End If Next CurRow End Sub 

编辑：您的DESTINATION表将现在添加最后使用的行后面的行。 此外，代码将检查值是否是第一个date，如果不是date，将会突出显示。

Answer 2

改变这一点

  If rng.Value = dat Then 

至

  If month(rng.Value) = dat Then