Sub IS_Loopfile()'
' Creates and Publishes Office Income Statement Reports'
'
Application.Run "TM1RECALC"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Sheets("Macro").Select
Dim new_wbk As String
new_wbk = "Field Income Statements - Key Accounts - " & Sheets("Macro").Range("G2").Value & " - " & Sheets("Macro").Range("G3").Value & ".xlsm"
Range("A4").Select
ActiveCell.End(xlDown).Select
Endrow = ActiveCell.Row
Workbooks.Add
' newdirectory = "Y:\"
' ChDrive newdirectory
' ChDir newdirectory
ActiveWorkbook.SaveAs FileName:=new_wbk, FileFormat:=52
For i = 4 To 43
Windows("Field Income Statements - Key Accounts Controllable - New Structure v4.xlsm").Activate
Office_code = Sheets("Macro").Range("a" & i).Value
PriorOffice = Sheets("Macro").Range("a" & i - 1).Value
Office_Name = Sheets("Macro").Range("b" & i).Value
PrOffice_Name = Sheets("Macro").Range("b" & i - 1).Value
Sheets("Income Statement").Select
Range("A6").Value = Office_code 'change the range
If i = 4 Then
Sheets("Income Statement").Copy After:=Workbooks(new_wbk).Sheets(1)
Else
Sheets("Income Statement").Copy After:=Workbooks(new_wbk).Sheets(PrOffice_Name)
End If
Sheets("Income Statement").Select
Sheets("Income Statement").Name = Office_Name
ActiveSheet.Range("A1").Activate
Next i
Windows("Field Income Statements - Key Accounts Controllable - New Structure v4.xlsm").Activate
Sheets("Macro").Copy After:=Workbooks(new_wbk).Sheets(1)
Sheets("Macro").Select
Windows("Field Income Statements - Key Accounts Controllable - New Structure v4.xlsm").Activate
Sheets("Cover").Copy After:=Workbooks(new_wbk).Sheets("Macro")
Sheets("Cover").Select
Windows(new_wbk).Activate
Application.Run "TM1RECALC"
For j = 3 To 3
Windows(new_wbk).Activate
OfficeSheet = Sheets("Macro").Range("b" & j).Value
Sheets(OfficeSheet).Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("A1:O1,A3:O3,A6:O6,A35:O35").Select
Selection.Merge
ActiveSheet.Range("A1").Activate
ActiveSheet.Range("H23").Select
Next j
For k = 4 To 4
Windows(new_wbk).Activate
OfficeSheet = Sheets("Macro").Range("b" & k).Value
Sheets(OfficeSheet).Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
'Hide Countrywide for Countrywide
Columns("U:AB").Select
Range("U16").Activate
Selection.EntireColumn.Hidden = True
ActiveSheet.Range("A1").Activate
ActiveSheet.Range("D17:AB17,D18:AB18,D19:AB19,D20:AB20,L23:S23,L24:S24,U23:AB23,U24:AB24").Select
Selection.Merge
ActiveSheet.Range("AB16").Select
Selection.Copy
ActiveSheet.Range("S16").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("A1").Activate
Next k
For l = 5 To 43
Windows(new_wbk).Activate
OfficeSheet2 = Sheets("Macro").Range("b" & l).Value
Sheets(OfficeSheet2).Activate
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
ActiveSheet.Range("D17:AB17,D18:AB18,D19:AB19,D20:AB20,L23:S23,L24:S24,U23:AB23,U24:AB24").Select
Selection.Merge
ActiveSheet.Range("A1").Activate
Next l
Sheets("Sheet1").Delete
Tab_Color_Change
Sheets("Countrywide").Select 'Change to reflect a element in the loop range!
Application.Dialogs(xlDialogSaveAs).Show
End Sub