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

Résolu/Fermé

Didoch54000 Messages postés 308 Date d'inscription vendredi 16 février 2007 Statut Membre Dernière intervention 27 décembre 2012 - 27 déc. 2012 à 17:45
Didoch54000 Messages postés 308 Date d'inscription vendredi 16 février 2007 Statut Membre Dernière intervention 27 décembre 2012 - 27 déc. 2012 à 19:30

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.

A voir également:

Copier des données d'un onglet à un autre sous condition
Copier une vidéo youtube - Guide
Rouvrir un onglet fermé - Guide
Excel cellule couleur si condition texte - Guide
Super copier - Télécharger - Gestion de fichiers
Copier un disque dur - Guide

2 réponses

Réponse 1 / 2

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
27 déc. 2012 à 18:30

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

Réponse 2 / 2

Didoch54000 Messages postés 308 Date d'inscription vendredi 16 février 2007 Statut Membre Dernière intervention 27 décembre 2012 26
27 déc. 2012 à 19:30

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

Discussions similaires

Dessiner avec son clavier et avec des lettres

Reporter des données d'une feuille dans une autre feuille

Exemple de base de données access

Discussions similaires

Newsletters