Suppression automatique de lignes et extractions de lignes

Papou-net à dit:

Bonjour llcoolf,

Le fichier ci-joint répond à ta 1ère question.

Pour la seconde, je n'ai pas compris le problème : peux-tu me le préciser avec un exemple, STP ?

Cordialement.

Cliquez pour agrandir...

llcoolf à dit:

Merci de ta réponse, c'est très gentil.

En fait j'aimerais ensuite extraire les lignes du fichier Flop selon le code dossier dans un autre feuillet mais toujours dans le même classeur.

Voici un exemple joint.

Cliquez pour agrandir...

Papou-net à dit:

Voici donc ton fichier complété.

J'ai rajouté un sous-programme "Extraction" dans le module de code 1.

Espérant avoir répondu à ton attente.

Cordialement.

Cliquez pour agrandir...

llcoolf à dit:

Excuses moi de te déranger Papou-net mais je ne trouve pas le sous programme dans le fichier joint.

Je te remercie encore de tes efforts

Cliquez pour agrandir...

Sub extraction()
Application.ScreenUpdating = False
With Feuil1
  nomsfeuilles = ""
  ' Récupère les noms des feuilles existantes
  For Each sh In Sheets
    nomsfeuilles = nomsfeuilles & sh.Name & " "
  Next
  ' Vérifie si les feuilles existent, sinon on les crée
  For Each cel In .Range("I2:I" & .Range("I65536").End(xlUp).Row)
    If InStr(nomsfeuilles, CStr(cel.Value)) = 0 Then
      Worksheets.Add after:=Worksheets(Sheets.Count)
      ActiveSheet.Name = CStr(cel.Value)
      nomsfeuilles = nomsfeuilles & CStr(cel.Value) & " "
      ' Recopie la ligne d'en-tête
      Feuil1.Rows(1).Copy
      ActiveSheet.Paste Destination:=Range("A1")
    End If
  Next
  ' Recopie les lignes en fonction des codes dossiers
  For Each cel In .Range("I2:I" & .Range("I65536").End(xlUp).Row)
    nomfeuille = CStr(.Cells(cel.Row, 9))
    lg = Sheets(nomfeuille).Range("A65536").End(xlUp).Row + 1
    Sheets(nomfeuille).Activate
    .Rows(cel.Row).Copy
    ActiveSheet.Paste Destination:=Range("A" & lg)
  Next
End With
Application.CutCopyMode = True
Application.ScreenUpdating = True
End Sub