Sub ExtractionISS()
Application.ScreenUpdating = False
'Dénomination des classeurs
Dim Wbk As Workbook
Dim ClasseurSource As Workbook
Dim ClasseurDest As Workbook
Set ClasseurSource = ThisWorkbook
For Each Wbk In Application.Workbooks
If Left(Wbk.Name, 8) = "ISS_File" Then
Set ClasseurDest = Wbk
Exit For
End If
Next Wbk
'message d'erreur si fichier ISS non-activé
On Error Resume Next
ClasseurDest.Activate
If Err.Number <> 0 Then
MsgBox "Avez-vous bien ouvert le fichier Excel de l'extraction ISS ?"
Else
'Copie des données ISS dans feuille temporaire
ClasseurSource.Activate
Sheets.Add.Name = "ISStemp"
ClasseurSource.Sheets("ISStemp").Range("A1:I10000") = _
ClasseurDest.Sheets("Comparison details").Range("A1:I10000").Value
'Définition des sous-totaux
Sheets("ISStemp").Range("A1").Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(4), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ActiveSheet.Outline.ShowLevels RowLevels:=2
'Copie des lignes de sous total
Sheets("ISStemp").Range("A1:AZ1000").SpecialCells(xlVisible).Copy _
Destination:=Sheets("ISS").Range("A1:AZ1000")
'supression des colonnes inutiles et attribution du nom "quantité"
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Range("B1").Value = "Quantité"
Sheets("ISS").Activate
Rows("1").Select
Selection.Delete Shift:=xlUp
'supression des colonnes inutiles et attribution des noms
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Range("A1").Value = "Référence"
Range("B1").Value = "Quantité"
'supression de la ligne "total général"
Dim I As Integer
For I = [A65000].End(xlUp).Row To 1 Step -1
If Not Cells(I, 1).Find("Total général") Is Nothing Then Rows(I).Delete
Next I
'efface les 6 premiers caracteres ("Total ") dans chaque cellule
Dim Nc, Cel As Range
For Each Cel In Range("A2", [A65000].End(xlUp))
Nc = Len(Cel)
Cel.Value = Right(Cel, Nc - 6)
Next Cel
Sheets("ISS").Cells.ClearFormats
'Supression de la feuille ISS et activation de la feuille principale
Application.DisplayAlerts = False
Sheets("ISStemp").Delete
Application.DisplayAlerts = True
ClasseurSource.Sheets("Consolidation").Activate
Application.ScreenUpdating = True
End If
On Error GoTo 0
End Sub