How to check range/column of cells based on month and copy them - excel

Question

So essentially, what I'm trying to do is this:
------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
I have a button and I want it to run a macro that checks if the dates in Column A fall within the current month. I've tried using
Month(Date)
but it checks the entire date, not the month only.
If the month in the cell in colmumn A equals the current month, I want it to copy the entire row of information corresponding to that particular cell. For example: When the current month is november, I want it to copy A8+B8+C8+D8, then I will paste that information in a whole different workbook.
Keep in mind that I'm completely new to VBA, but this is what I've come up with so far:
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
Nothing really happens. If I change it to dat=Date then it only works for this particular day, and it takes forever to run through 1000 cells.
I was thinking if I could use Cells(Rows.Count, "A").End(xlUp).Value = Month(Date) somehow. Is this even possible?
EDIT: To paste in a different workbook I used the following commands:
Dim wb As Workbook
Set wb = Workbooks.Open("C:\Users\....DOCUMENT.xlsm")
And then to paste:
wb.Sheets("Sheet1").Range("A" & NextDest & ":F" & NextDest).PasteSpecial

Answer 1

Just change the "Destination Sheet" to the name of the sheet you want to copy to.
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
Edit: Your DESTINATION SHEET will now add rows after the last used row. Also, the code will check if the value is a date first and will highlight if not a date.

Answer 2

Change this
If rng.Value = dat Then
To
If month(rng.Value) = dat Then