option to get data by month or week

[swallis]

This is a workbook called Production and the objective files are in the Path C:\ ~\~\~\Sales\Year\Month\Week\files.xls. The macro below opens the file dialog box in Year and the user drills down to the required Week. The macro copies a list of the files in the Week folder to Sheet “Master” in Production, then opens each file in the Week folder and closes it, after copying data across to Sheet “All” in Production.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
I would like to allow the user the option to run the macro from either the Week or Month folder. If the latter is chosen, the macro would list and copy data from each weekly folder in the month. If it’s simpler to have one or the other, I would choose Month<o></o>
<o></o>
A related issue is to somehow simply change the Year the dialog box opens in to the current year – without asking anybody to change the code. I (vba challenged) am doing this for a friend (vba ignorant) and may not always be maintaining it.<o></o>
<o></o>
Finally, the code works in Excel 2003, but has to translate to Excel 2007 (I know file type has to change). It’s been cobbled together by a combination of search, copy, paste and fiddle. If anyone feels the urge to tidy it up, simplify it or make it more efficient, I’d be very appreciative. <o></o>

Sub GetData()
Dim fPATH As String, fNAME As String, NR As Long
Dim wsALL As Worksheet, ws As Worksheet, wbDATA As Workbook
Dim xRow As Long
Dim blnFlag As Boolean
Dim xDirect$, xFname$
    Sheets("Master").Select
    Cells(Rows.Count, "a").End(xlUp).Offset(1).Select
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\Users\Steve\Desktop\Public Files\Products\Sales\Sales 12"
        .Title = "Choose Folder"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count <> 0 Then
            xDirect$ = .SelectedItems(1) & "\"
            xFname$ = Dir(xDirect$, 7)
            Do While xFname$ <> ""
                blnFlag = True
                ActiveCell.Offset(xRow) = xFname$
                xRow = xRow + 1
                xFname$ = Dir
            Loop
        End If
        If .SelectedItems.Count <> 0 Then
            fPATH = .SelectedItems(1) & "\"
            fNAME = Dir(fPATH & "*.xl*")
            Do While Len(fNAME) > 0
            Set wbDATA = Workbooks.Open(fPATH & fNAME)
            Sheets("Sheet1").Select
            Range("A16", Range("d16").End(xlDown)).Select
            Selection.Copy
            Workbooks("Production.xlsm").Activate
            Sheets("All").Select
            Cells(Rows.Count, "a").End(xlUp).Offset(1).Select
            ActiveSheet.Paste
            Application.CutCopyMode = False
              With Selection.Font
                   .Name = "Arial"
                   .Size = 10
              End With
             wbDATA.Close False
            fNAME = Dir
            Loop
        End If
    End With
    If blnFlag = False Then MsgBox "No files found"
End Sub