Copier des données d'un onglet à un autre sous condition

[Résolu/Fermé]
Signaler
Messages postés
308
Date d'inscription
vendredi 16 février 2007
Statut
Membre
Dernière intervention
27 décembre 2012
-
Messages postés
308
Date d'inscription
vendredi 16 février 2007
Statut
Membre
Dernière intervention
27 décembre 2012
-
Bonjour,

Exposé du sujet : Dans un fichier Excel j'ai un onglet nommé extraction qui contient environ 55 colonnes et 45000 lignes, je souhaiterais 'éclater' ces données dans d'autres onglets en fonction de la valeur contenue dans la colonne "AW", cette colonne ne prends que 6 valeurs différentes, qui seront également le nom de mes onglets.

Un peu code :
Dans un premier temps je trie mes valeurs :
Sub TriValeur(DernLigne)

 Range("A2:AY" & DernLigne).Select
 Selection.Sort Key1:=Range("AW1"), Order1:=xlAscending, _
 OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

End Sub



Ensuite je fait un select case pour analyser la valeur de la cellule AW(x) :

[...]
DernLigne = Range("A" & Rows.Count).End(xlUp).Row
[...]

For i = 2 To DernLigne
Select Case Range("AW" & i).Value
   Case "Jean"
        col = col + 1
        MonOnglet = "extraction Jean"
        En gros ici je souhaiterais faire un copier de toutes les lignes qui contiennent Jean dans la colonne AW et les copier dans un onglet nommé "Extraction Jean"
                
    Case "Pierre"
        leg = leg + 1
        MonOnglet = "extraction Pierre"
              
    Case "Paul"
        mat = mat + 1
        MonOnglet = "extraction Paul"
                
    Case "Bob"
        por = por + 1
        MonOnglet = "extraction Bob"
              
    Case "Toto"
        sig = sig + 1
        MonOnglet = "extraction toto"
                   
    Case Else
    MsgBox (" Valeur non traitée")
End Select
Next i


Comment est-ce que je peux faire pour récupérer l'ensemble des valeurs et les coller dans les onglets correspondant à "MonOnglet" ?

J'ai essayer de comprendre en faisant une macro assistée dans Excel mais... :


Sub copy()
'
' copy Macro
'

'
    Range("AY2").Select
    Range(Selection, Cells(ActiveCell.Row, 1)).Select
    Selection.copy
    Sheets("extraction Jean").Select
    Rows("2:2").Select
    Range("AJ2").Activate
    ActiveSheet.Paste
End Sub


J'espère être comprehensible .
En vous remerciant par avance pour votre aide.

2 réponses

Messages postés
15958
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
19 septembre 2021
1 534
Bonjour,

Une facon de faire:

Sub TriValeur()
  Dim Plage As Range, Cel As Range
  
  'Nom de feuille a adapter
  Worksheets("feuil1").Activate
  With Worksheets("feuil1")
    DernLigne = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A2:AY" & DernLigne).Sort Key1:=.Range("AW1"), Order1:=xlAscending, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  End With
  Set Plage = Worksheets("feuil1").Range("AW2:AW" & DernLigne)
  MonOnglet = "NOk"
  For Each Cel In Plage
    Select Case Cel.Value
      Case "Jean"
        col = col + 1
        MonOnglet = "extraction Jean"
      Case "Pierre"
        leg = leg + 1
        MonOnglet = "extraction Pierre"
      Case "Paul"
        mat = mat + 1
        MonOnglet = "extraction Paul"
      Case "Bob"
        por = por + 1
        MonOnglet = "extraction Bob"
      Case "Toto"
        sig = sig + 1
        MonOnglet = "extraction toto"
      Case Else
        MonOnglet = "NOk"
        MsgBox (" Valeur non traitée")
    End Select
    
    If MonOglet <> "NOk" Then
      With Worksheets(MonOnglet)
        'Premiere cellule vide colonne A de l'Onglet fonction du Prenom
        DlOnglet = .Range("A" & Rows.Count).End(xlUp).Row + 1
        'Copie de la ligne
        Worksheets("Feuil1").Rows(Cel.Row & ":" & Cel.Row).copy .Range("A" & DlOnglet)
      End With
    End If

  Next Cel

End Sub


Bonne fete de fin d'annee
Messages postés
308
Date d'inscription
vendredi 16 février 2007
Statut
Membre
Dernière intervention
27 décembre 2012
26
Bonsoir F894009,


Juste un grand bravo et merci apres quelques retouche pour adapter le code à mes besoins ca marche parfaitement .

Merci encore

Bonne fêtes à toi également et à tous le forum