Snasui Excel Forum

Code: Select all

Sub Apr()
    Dim CrntWorkBook As Workbook
    Dim SourceBook As Workbook
    Dim SourceRange As Range
    Dim Destination As Range

    Set CrntWorkBook = ActiveWorkbook
    
     With Application.FileDialog(msoFileDialogOpen)
        .Title = "File "
        .InitialFileName = ThisWorkbook.Path & " \ "
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xl*;*.xm*"
        .AllowMultiSelect = False
        .Show
         
        If .SelectedItems.Count > 0 Then
                Workbooks.Open .SelectedItems(1)
                Set SourceBook = ActiveWorkbook
                
    Sheets("IFCN Sale Amount").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields( _
        "[Raw Data 3 Y].[Month].[Month]").VisibleItemsList = Array("")
    ActiveSheet.PivotTables("PivotTable1").PivotFields( _
        "[Raw Data 3 Y].[Month].[Month]").VisibleItemsList = Array( _
        "[Raw Data 3 Y].[Month].&[04]")
    CrntWorkBook.Activate
    ActiveWindow.SmallScroll Down:=-38
    Range("P6").Select
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(VLOOKUP([@Area],'[1_ReportSOS.xlsx]FOM'!C2:C3,2,0),0)"
    Range("P6").Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=38
    Range("P6:P70").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("P6:P70").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    
        
             SourceBook.Close False
            End If
        End With
End Sub