VBA to take a date from a cell on sheet2 and find that date in column A on sheet1

[danbates]

Hi,

I have a range of cells on Sheet2 Q1:Q12.
They have the third Sunday of each month and they are found with a formula.

On Sheet1 I have column A with all the dates of the year.
Each date is 2 cells merged because in column B I have the colour of which shift will be at work. On either Days or Nights.

I would like a code that can look at cell Q1 on Sheet2 and then find that date on Sheet1.
Then I would like it to copy the night shift colour and paste it to A1 on Sheet2.
Then it to carry on and do the same for the rest of the range on Sheet2. Q1:Q12.

I've added an image so you can see what I mean with regards to how Sheet1 looks.

Any help would be much appreciated.

Thanks

Dan

 

[danbates]

I found this code online. I have added the last 8 lines of code which makes the code do exactly what I wanted for 1 part of my original question.

Sub JAN()

'declare variables
Dim ws As Worksheet
Dim SelectCells As Range
Dim xcell As Object
Dim Rng As Range
Set ws = Worksheets("Sheet1")
Set Rng = ws.Range("A1:A730")
'check each cell in a specific range if the criteria is matching
For Each xcell In Rng
If xcell.Value = Worksheets("Sheet2").Range("Q1") Then
If SelectCells Is Nothing Then
Set SelectCells = Range(xcell.Address)
Else
Set SelectCells = Union(SelectCells, Range(xcell.Address))
End If
End If

Next

SelectCells.Select
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(1, 0).Select

Selection.Copy
Sheets("Sheet2").Select
Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
Sheets("Sheet1").Select
End Sub

Please could someone help me alter the code so it does the same for the following:
Q2 copy to A2
Q3 to A3 and so on to
Q12 to A12.

Thanks

Dan