vba For Loop using AutoFilter with Variable Criteria

[rmagedyn]

I'm trying to automate several daily reports, and have run into a snag on my 1st go at it ... I used the Macro Recorder to lay the groundwork, and then consolidated the repetitive steps in a For Each/Next loop. It begins with 1 sheet that needs to be cut and pasted across up to 5 sheets. I found a lot of useful info across the web, and put together the following:

Sub Daily_Pending()
'
' Daily_Pending Macro
' Daily Pending Report Macro
'
'


Dim Region As Variant
    
Call CriteriaList
    Columns("AU:AV").Select
    Selection.Delete Shift:=xlToLeft
    ActiveSheet.Range("A1:AF1").AutoFilter
    On Error Resume Next
    For Each Region In Worksheets("Sheet1").Range("AU2:AU6").Cells
        Range("A1").Select
        Call LCell
[COLOR=#ff0000]        ActiveSheet.Range("$A$1:$AF$" & LastCell.Row).AutoFilter Field:=1, Criteria1:= _[/COLOR]
[COLOR=#ff0000]            "=" & Region.Value   [/COLOR] [COLOR=#008000]<=== Variable for Criteria1 - Apparently this line is ignored[/COLOR]
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        Sheets.Add After:=Sheets(Sheets.Count)
        On Error Resume Next
[COLOR=#ff0000]        ActiveSheet.Name = Region.Value[/COLOR]
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        Application.CutCopyMode = False
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        With ActiveWindow
            .SplitColumn = 1
            .SplitRow = 0
        End With
        ActiveWindow.FreezePanes = True
        Columns("A:A").ColumnWidth = 20
        Columns("B:GG").Select
        Columns("B:GG").EntireColumn.AutoFit
[COLOR=#ff0000]        If Columns("B:GG").EntireColumn.ColumnWidth > 48 Then[/COLOR]
[COLOR=#ff0000]            Columns("B:GG").EntireColumn.ColumnWidth = 48[/COLOR]
[COLOR=#ff0000]        End If[/COLOR]
        Cells.Select
        Cells.EntireRow.AutoFit
        Range("B1").Select
        Sheets("Daily Pending _ Afte").Select
        Rows("2:2").Select
        Range("A2").Activate
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Delete Shift:=xlUp
    Next Region

The code works without error, creates the 6 additional sheets (1 for the Range values), but it doesn't name them. It copies and transposes the entire contents of the original sheet to the second sheet created rather than filtering it based off the range value. It also doesn't seem to format the column widths to a max of 48 Is this even possible? Below is the code for the sub and function that this sub calls (All three are in separate modules):

Sub CriteriaList()


Sheets.Add After:=Sheets(Sheets.Count)
Sheets("Daily Pending _ Afte").Select


With ActiveSheet
    .Range("A1", .Range("A1").End(xlDown)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("Sheet1").Range("A1"), Unique:=True
    Sheets("Sheet1").Range("A1").Delete Shift:=xlShiftUp
End With


End Sub

Public Function LCell()
Dim LastCell As Range
Dim LastCellRowNumber As Long


Set WS = Worksheets("Sheet1")
With WS
    Set LastCell = .Cells(.Rows.Count, "AF").End(xlUp)
    LastCellRowNumber = LastCell.Row
End With
Return
End Function