creer un nouveau fichier

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim lettre As String, F As Worksheet, lig As Long
lettre = Right(Sh.Name, 1)
If InStr("TPO", lettre) = 0 Then Exit Sub
Set F = Sheets("ecart G")
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'à cause des liaisons...
F.Cells.Copy Sh.[A1] 'pour les formats
Sh.UsedRange = F.UsedRange.Value 'supprime les formules
lig = Sh.UsedRange.Row + Sh.UsedRange.Rows.Count - 1
For lig = lig To 5 Step -1 'adapter le 5 éventuellement
  If Sh.Cells(lig, "E") <> lettre Then Sh.Rows(lig).Delete
Next
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim lettre As String, F As Worksheet, lig As Long
lettre = Right(Sh.Name, 1)
If InStr("TPO", lettre) = 0 Then Exit Sub
Set F = Sheets("ecart G")
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'à cause des liaisons...
F.Cells.Copy Sh.[A1] 'pour les formats
Sh.UsedRange = F.UsedRange.Value 'supprime les formules
lig = Sh.UsedRange.Row + Sh.UsedRange.Rows.Count - 1
If lig < 5 Then Exit Sub 'adapter le 5 éventuellement
With Sh.Range(Sh.Cells(5, 5), Sh.Cells(lig, 5))
  Me.Names.Add "matrice", .Value 'nom défini par une matrice
  .FormulaArray = "=LN(matrice=""" & lettre & """)"
  .Value = .Value
  .EntireRow.Sort .Cells(1), Header:=xlNo 'tri pour accélérer la suppression
  On Error Resume Next
  .SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
  .Value = lettre
  Me.Names("matrice").Delete
End With
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Copie Sheets("ecart P"), Sh
Copie Sheets("ecart G"), Sh
End Sub

Sub Copie(F As Worksheet, Sh As Worksheet)
If Not Sh.Name Like F.Name & "?" Then Exit Sub
Dim lettre As String, lig As Long
lettre = Right(Sh.Name, 1)
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'à cause des liaisons...
F.Cells.Copy Sh.[A1] 'pour les formats
Sh.UsedRange = F.UsedRange.Value 'supprime les formules
lig = Sh.UsedRange.Row + Sh.UsedRange.Rows.Count - 1
If lig < 5 Then Exit Sub 'début en ligne 5
With Sh.Range(Sh.Cells(5, 5), Sh.Cells(lig, 5))
  Me.Names.Add "matrice", .Value 'nom défini par une matrice
  .FormulaArray = "=LN(matrice=""" & lettre & """)"
  .Value = .Value
  .EntireRow.Sort .Cells(1), Header:=xlNo 'tri pour accélérer la suppression
  On Error Resume Next
  .SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
  .Value = lettre
  Me.Names("matrice").Delete
End With
End Sub