Sleeper: Copy/Paste results of an if & else from all wrksheets to a wrksheet

[bananatang]

Hi Guys,

i really could do with some help here. I have been banging my head for hours & hours trying to move forward to a workable solution.

My goal is to copy selected cell values (E5,E6,E7 & N6) from all attendance worksheets that contains a specific value in a nominated cell and paste to a worksheet. i.e if cell Z16 contains the numeric value 2, i want the macro to copy selected cells to another worksheet called "Weekly Attendance". If the cell contains any other value to ignore the worksheet.

In addition , within the workbook are other worksheets that are not related to attendance and should not be included in the macro.

To further complicate things some of the cell that i wish to be copied are fixed. i.e the cell location will not change. however i require to incorporate an input box in order for the user to choose which weeks data they wish to extract. The week No. are fixed within column B, range (B19:B72). Based on the location of the week no. the user has chosen. i want the macro to copy that cell value and the following 12 cells adjacent to the cell and post them in the "weekly attendance" worksheet, in addition to the fixed cells values.

I have included the code that i have been working on, however it does need correcting. it is probably not the most efficient way of doing this. I am open to alternative methods of acheiving my goals.

I have also included a copy of my workbook for easier understanding.

I would appreciate any help anyone can provide.

Thanks

BT

Sub zzz()
Application.ScreenUpdating = False
Wkly_Attendance.Visible = xlSheetVisible 'Show wkly attendance worksheet
Wkly_Attendance.Select
Dim wks As Worksheet
Dim aryVals(1 To 1, 1 To 4)
Dim lOpenRow As Long
With Wkly_Attendance
     .Range(.Cells(3, 1), .Cells(Rows.Count, 17)).ClearContents
     '// Start filling at row two, as we cleared any prior run//
     lOpenRow = 3
     For Each wks In ThisWorkbook.Worksheets
         n'If Range("Z16").Value = "2" Then
         '// Test to ensure we're not grabbing data from a sheet we don't    //
         '// want to.  NOTE:  We are using the codename of RawData, not the  //
        '// sheet (tab) name                                                //
        If Not wks Is Wkly_Attendance _
            And Not wks.Name = "test" _
            And Not wks.Name = "test1" _
            And Not wks.Name = "test2" Then
                '// Fill an array with the vals; I think this should be faster  //
                '// than copying individual cells.                              //
                aryVals(1, 1) = wks.Range("E5")
                aryVals(1, 2) = wks.Range("E6")
                aryVals(1, 3) = wks.Range("E7")
                aryVals(1, 4) = wks.Range("N6")
                 '// dump the array into the next available row                  //
                .Range(.Cells(lOpenRow, 1), .Cells(lOpenRow, 4)).Value = aryVals
                lOpenRow = lOpenRow + 1
            End If
      Next
End With
MsgBox "Upload Complete", vbInformation + vbokok, "Upload Attendance Data"
End Sub

Sub input_box2()
Dim wks As Worksheet
Dim aryVals(1 To 1, 1 To 4)
Dim lOpenRow As Long
With Wkly_Attendance
    .Range(.Cells(3, 5), .Cells(Rows.Count, 17)).ClearContents
    '// Start filling at row two, as we cleared any prior run//
    lOpenRow = 3
    For Each wks In ThisWorkbook.Worksheets
        Dim MyInput
        MyInput = InputBox("Enter Week No.")
        Range("B19:B74").Select
        Selection.Find(What:=MyInput, After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
        ActiveCell.Offset(, 0).Resize(, 13).Copy
        Sheets("Weekly Attendance").Select
        Range("E3").End(xlUp).Select
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Next
End With
End Sub