VBA Macro: Copy and Paste Specific Row Range based on the Specific Value in a Cell.

OK, added some new features.

1) The DAILYAVAILABILITY Macro now looks at cell C1 on each sheet from which it is called to see what "week #" you have selected to display.
2) C1 has a drop down listing all the Week #s currently contained on the Availability sheet
3) The ThisWorkbook module now has a "SheetActivate" macro that updates the drop down list in realtime anytime you activate a sheet. So the drop down will always be current for the sheet you are reviewing.
4) If the current value of C1 is NOT a week that is found on the Availability sheet any longer, the sheet automatically run the update macro to display the first week it does find. After that, you can select any other week from the C1 drop down and UPDATE it again.

ThisWorkbook code:

Option Explicit

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim buf As String, cell As Range

If Sh.Name <> "Availability" Then
    With Sheets("Availability")
        For Each cell In .Rows(1).SpecialCells(xlConstants)
            If cell.Value <> "" Then
                If buf = "" Then
                    buf = cell.Value
                Else
                    buf = buf & "," & cell.Value
                End If
            End If
        Next cell
    End With
    If buf <> "" Then
        With Sh.Range("C1").Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=buf
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
        Range("C1").Activate
        If InStr(buf, Range("C1").Value) = 0 Then
            If InStr(buf, ",") = 0 Then
                Range("C1") = buf
            Else
                Range("C1") = Left(buf, InStr(buf, ",") - 1)
            End If
            Call Module1.DailyAvailability
        End If
    End If
End If

End Sub

Updated DailyAvailibilty code in module1:

Option Explicit

Sub DailyAvailability()
Dim wsMAIN As Worksheet, wsME As Worksheet, meFIND As Range, LR As Long
Dim wkFIND As Range

Set wsMAIN = Sheets("Availability")             'the sheet with the hours
Set wsME = ActiveSheet                          'the currrent sheet to update

On Error Resume Next
With wsMAIN
    Set wkFIND = wsMAIN.Rows(1).Find(wsME.Range("C1").Text, LookIn:=xlValues, LookAt:=xlWhole).MergeArea.Cells
    LR = .Range("A" & .Rows.Count).End(xlUp).Row        'find the last row of availability date
    Set meFIND = Intersect(.Range(wkFIND.Address).EntireColumn, .Rows(2)).Find(wsME.Name, _
                   LookIn:=xlValues, LookAt:=xlWhole)   'find the current day
    If Not meFIND Is Nothing Then                       'if sheetname/day is found, proceed
        wsME.UsedRange.Offset(1).Clear                  'clear prior info
        .AutoFilterMode = False                         'remove prior filters
        .Rows(3).AutoFilter meFIND.Column, "Active"     'filter daily column for "active" only
        .Range("A2:F" & LR).Copy wsME.Range("A2")       'copy name info, then copy hours
        .Range(.Cells(2, meFIND.Column - 2), .Cells(LR, meFIND.Column - 1)).Copy wsME.Range("G2")
        .AutoFilterMode = False
        Application.CutCopyMode = False
        wsME.Columns.AutoFit
    End If
End With

End Sub