Sub ReformatingFile()
' msgbox + comfrime macro
Dim Response As Integer
' Displays a message box with the yes and no options.
Response = MsgBox(prompt:="CAREFUL" & vbNewLine & "this macro will delete alter the original file." & vbNewLine & "Please backup the original before lauching the macro." & vbNewLine & "Do you want to proceed with this macro ?" & vbNewLine & "Created by Rémi Tuyaerts" & vbNewLine & "2013", Title:="INFORMATION")
' Split original into sections
Dim lLoop As Long, lLoopStop As Long
Dim rMove As Range, wsNew As Worksheet
Set rMove = ActiveSheet.UsedRange.Columns(1)
lLoopStop = WorksheetFunction.CountIf(rMove, "Section*")
For lLoop = 1 To lLoopStop
Set wsNew = Sheets.Add
rMove.Find("Section*", rMove.Cells(1, 1), xlValues, _
xlPart, , xlNext, False).CurrentRegion.Cut _
Destination:=wsNew.Cells(1, 1)
wsNew.UsedRange.Columns.AutoFit
Next lLoop
' Delete orignial sheet
Worksheets("RoughData_139190_cecile_mignon_").Delete
' ask user for month name
Dim monthName As String
monthName = InputBox(prompt:="What month is this file from ?", _
Title:="Please entre name of the month", Default:="January 2013")
' insert a column
Dim sht As Worksheet
For Each sht In ActiveWorkbook.Worksheets
sht.Activate
Columns("A:A").Insert Shift:=xlToLeft, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A3").Value = monthName
Dim lRow As Long
With ActiveSheet
lRow = .Range("B" & Rows.Count).End(xlUp).Row
.Range("A3:A" & lRow).FillDown
End With
Next sht
' Creating table of content
Dim ws As Worksheet
Set ws = Sheets.Add
Sheets.Add.Name = "Table_Of_Content"
' Filling TOC
Dim WorkS As Worksheet
For Each WorkS In ActiveWorkbook.Worksheets
Sheets("Sheet1").Range("B1").Copy
Sheets("Table_Of_Content").Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next WorkS
Application.Run "SynthesisVSD"
End Sub
Sub SynthesisVSD()
' adding new sheet for
Dim syn As Worksheet
Dim LastRow As Long, National As Double
Set syn = Sheets.Add
Sheets.Add.Name = "SynthesisVSD"
' copy TOTAL NUMBER OF CALLS
N = Worksheets("Sheet6").Range("B:B").Cells.SpecialCells(xlCellTypeConstants).Count
Range("A1").Value = "Voice"
Cells(1, 1).Font.Bold = True
Cells(1, 1).Font.Size = 15
Range("A2").Value = "Total number of calls"
Range("B2").Value = N - 2
'Copy COST FOR NATIONAL CALLS
ActiveWorkbook.Sheets("Sheet6").Activate
Const LookupType As String = "Communications nationales"
LastRow = Cells(Rows.Count, "O").End(xlUp).Row
National = WorksheetFunction.SumIf(Range("O2:O" & LastRow), LookupType, Range("R2:R" & LastRow))
ActiveWorkbook.Sheets("SynthesisVSD").Activate
Range("A3").Value = "Total cost of National Communications"
Range("B3").Value = National
End Sub
Sub ic()
'Copy COST FOR INTERNATIONAL CALLS
National = WorksheetFunction.SumIf(Range("O2:O" & LastRow), LookupType, Range("R2:R" & LastRow))
TotalIN = 0
ActiveWorkbook.Sheets("Sheet6").Activate
Dim LookupType As Variant, vItem As Variant
LastRow = Cells(Rows.Count, "O").End(xlUp).Row
LookupType = Array("Communications internationales", _
"Communications effectuées a l'étranger (ROAMING)", _
"Communications recues a l'étranger (ROAMING)")
For Each vItem In LookupType
National = National + WorksheetFunction.SumIf(Range("O2:O" & LastRow), LookupType, Range("R2:R" & LastRow))
Next
ActiveWorkbook.Sheets("SynthesisVSD").Activate
Range("A4").Value = "Total cost of International Communications"
Range("B4").Value = National
'copy NUMBER OF SMS
N = Worksheets("Sheet7").Range("B:B").Cells.SpecialCells(xlCellTypeConstants).Count
Range("A5").Value = "SMS"
Cells(5, 1).Font.Bold = True
Cells(5, 1).Font.Size = 15
Range("A6").Value = "Total number of sms"
Range("B6").Value = N - 2
' autofit cells
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
' Sorting sheet in acsending order
Dim i As Integer
Dim j As Integer
Dim iAnswer As VbMsgBoxResult
iAnswer = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) _
& "Clicking No will sort in Descending Order", _
vbYesNoCancel + vbQuestion + vbDefaultButton1, "Sort Worksheets")
For i = 1 To Sheets.Count
For j = 1 To Sheets.Count - 1
If iAnswer = vbYes Then
If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then
Sheets(j).Move After:=Sheets(j + 1)
End If
ElseIf iAnswer = vbNo Then
If UCase$(Sheets(j).Name) < UCase$(Sheets(j + 1).Name) Then
Sheets(j).Move After:=Sheets(j + 1)
End If
End If
Next j
Next i
End Sub
