How to pull entire row data from 1 sheet to another ONLY if a cell in row is from this week

[samnz]

Creating a Sport Draws & Results spreadsheet.

The first sheet is "This Week" while following sheets are "Netball", "Football" etc. In a sport sheet there are rows of data that contain the team, date, time, opposition, location, and results. See below:

1st XV Boys

Wed

14-Aug

7 pm

v

Dilworth

Home

Field 7

Quarterfinal

23

v

8

win

<tbody>
</tbody>

There would be a large number of rows in a sport sheet as would contain all the teams within that sport, and all the games for that year.


How can I pull content from a sport sheet into "This Week" sheet, ONLY if the date is within the current week?


So "This Week" sheet would be a list of all teams and all sports playing in the current week...

Football

1st XV Boys

Sat

17-Aug

7 pm

v

Dilworth

Home

Field 7

Final

23

v

8

win

<tbody>
</tbody>

2nd XV Boys

Sat

17-Aug

8 pm

v

Dilworth

Dilworth

Field 7

Final

v

<tbody>
</tbody>

Netball

Premier Girls

Sat

17-Aug

9 pm

v

Auckland Grammar

Auckland Grammar

Court 9

Semifinal

v

<tbody>
</tbody>

Senior A Girls

<tbody>
</tbody>

Happy for there to be no content sitting alongside a Teams name in "This Week" if there is no row with the current week. i.e. Senior A Girls under Netball left blank

 

[JLGWhiz]

See if this is close. This code should be copied into the standard code module 1. To access the code module, press Alt + F11. You will need to ensure that macros are enabled and access to VBA has been established. The workbook which hosts the code must be saved as a macro enabled workbook if your Excel version is 2007 or later.

Sub sports()
Dim sh As Worksheet, lr As Long
Set sh = Sheets(1)
x = Application.WeekNum(Date)
    For p = 2 To 5 'Assumes sports sheets are 2 thru 5
        lr = Sheets(p).Cells(Rows.Count, 3).End(xlUp).Row
        For i = 2 To lr
            If x = Application.WeekNum(Sheets(p).Range("C" & i).Value) Then
                 Sheets(p).Rows(i).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
            End If
        Next
    Next
End Sub

 

[samnz]

Sorry JLGWhiz, this didn't help. Thanks for trying

 

[samnz]

The beginnings of the document can be found here
https://www.dropbox.com/s/ehazfa674pggymr/Sport Draws & Results.xlsx

At the moment, the data entry is fake but it does include everything will be needing

 

[Hercules1946]

Cross posted here:

How to pull entire row data from 1 sheet to another ONLY if cell in row is this week

Solution posted at the other location