Copier des données d'un onglet à un autre sous condition Résolu/Fermé

Question

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.

Configuration: Windows 8 / Internet Explorer 10.0

f894009 · Answer

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

Didoch54000 · Answer

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

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

2 réponses

Discussions similaires