[RESOLU] VBA : Copier sur une feuille selon condition

[Brudy]

Bonjour à tous,

J'espère que le titre ne vous à pas trop fait rire mais j'ai vraiment du mal à comprendre la démarche pour le moment.

J'ai aujourd'hui une problématique sur une base de donnée assez lourde et j'aimerais pour faciliter mon travail que chaque ligne contenant une condition soit copier coller sur une autre feuille, ligne par ligne à la suite des autres.

Rien de bien compliqué en soit, mais j'ai besoin d'un peu d'aide et de support pour m’imprégner de la démarche.

Merci d'avance à ceux qui vont me répondre.

Brudy

 

[Theze]

Bonjour,

Une piste.
Tout d'abords, je suis parti du principe que les feuilles doivent recevoir les mêmes entêtes de colonnes que la feuille "Base" mais et c'est là qu'il te faut faire attention, j'ai pris comme cellule de départ la cellule A1 donc, pour le test, vide toutes tes feuilles des valeurs qu'elles contiennent du classeur que tu as mis en exemple et lance la macro pour voir le résultat. Attention aussi, si une feuille n'existe pas, elle sera créée et portera le nom de l'entrepôt en cours :

Sub Test()
   
    Dim FeBase As Worksheet
    Dim Fe As Worksheet
    Dim Plage As Range
    Dim Cel As Range
    Dim Ligne As Long
   
    Set FeBase = Worksheets("Base")
   
    'défini la plage de recherche sur la colonne A de la feuille "Base" à partir de A4
    With FeBase: Set Plage = .Range(.Cells(4, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
   
    'parcours la plage
    For Each Cel In Plage
       
        'si la feuille n'existe pas, une erreur est générée
        On Error Resume Next
        Set Fe = Worksheets(Cel.Value)
       
        'donc, création de la feuille avec le nom correspondant
        If Err.Number <> 0 Then
       
            Set Fe = Worksheets.Add(, Sheets(Sheets.Count))
            Fe.Name = Cel.Value
            Err.Clear
           
        End If
       
        'cherche la dernière ligne non vide en colonne A de la feuille en cours
        With Fe: Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row: End With
       
        'si elle est égale à 1 et que la cellule A1 est vide, inscrit les entêtes de colonnes
        If Ligne = 1 And Fe.Cells(1, 1).Value = "" Then
            Fe.Range(Fe.Cells(1, 1), Fe.Cells(1, 7)).Value = FeBase.Range(FeBase.Cells(3, 1), FeBase.Cells(3, 7)).Value
        End If
       
        'inscrit les valeurs dans la ligne vide située dessous (+1)
        Fe.Range(Fe.Cells(Ligne + 1, 1), Fe.Cells(Ligne + 1, 7)).Value = FeBase.Range(Cel, Cel.Offset(, 6)).Value

    Next Cel
   
End Sub

 

[Brudy]

Merci à toi Theze,

Ta macro fonctionne au top,

Merci d'avoir pris le temps de bien expliquer ta démarche,

néanmoins, une problématique ce pose. Ici j'ai réduit les infos dispo, mais dans mon tableau initial j'ai une ligne interminable d'information et lors de la copie et le collage j'aimerais sélectionner ces infos.

Ligne original : Entrepôt - Frs - N commande- date - vendeur
Ligne collé dans la feuille correspondante : Entrepôt - Frs - N commande - vendeur
Par exemple


Et également, faire que la macro boucle ? Ou peut être est ce trop lourd et il vaux mieux l'activer via bouton ?


Merci du temps accordé pour ce soucis !

 

[Theze]

Re,

Tu veux pouvoir choisir les colonnes où récupérer les valeurs dans la feuille "Base" ? Et ces valeurs, doivent t'elles être ensuite collées les unes aux autres (colonne A, puis colonne B, etc...) ou doivent t'elles être dans leurs colonnes respectives ?

 

[Brudy]

Dans l'idéal le plus compact possible,

Donc sélectionner des données en A1,A2,A3,A5;A7;A18 par exemple
et les transcrire à la suites dans la feuille de destination.

Merci encore

 

[Theze]

Tu veux pouvoir choisir les lignes et non les colonnes ?

 

[Brudy]

J'ai du mal à me faire comprendre semble t il,

Je t'envoie mon fichier en essayant d'être plus explicite !

 

[Brudy]

Pour faire suite,

Je trifouille depuis que tu m'a envoyé ta macro, un régal vraiment mais je m'y retrouve pas dans mon fichier officiel,

Je l'ai mis en forme pour pouvoir le mettre ici, peut être que tu pourrais m'éclairer.

Impossible notamment d'adapter la plage à sélectionner et à coller :'(

Mon besoin :
-Trier par feuille en fonction de l'entrepot, donc copie collage de la ligne dans sa feuille d'entrepot.
- Nécessité de pouvoir actualiser pour copier/coller tout en ne créant pas de doublon pour que les lignes s'ajoutent à la suite au fur et à mesure que la bdd grossis

Merci d'avance

 

[Brudy]

Bon suite a mes bidouillage voici mon code, fonctionnel selon la première étape ! je remercie fortement Theze,
Cependant j'aimerais que l'action de copier coller ce repete, sans créer de doublon et en continuant la liste de données dans chaque feuille.

Je suis carrément bloqué ! J'ai beau essayer, rien n'y fait, ma liste ce double, ce redouble.

Un peu d'aide serait la bienvenue

Sub Test()
  
    Dim FeBase As Worksheet
    Dim Fe As Worksheet
    Dim Plage As Range
    Dim Cel As Range
    Dim Ligne As Long
  
    Set FeBase = Worksheets("PENALITE")
  
   
    With FeBase: Set Plage = .Range(.Cells(6, 2), .Cells(.Rows.Count, 2).End(xlUp)): End With
  
   
    For Each Cel In Plage
      
        '
        On Error Resume Next
        Set Fe = Worksheets(Cel.Value)
      
       
        If Err.Number <> 0 Then
      
            Set Fe = Worksheets.Add(, Sheets(Sheets.Count))
            Fe.Name = Cel.Value
            Err.Clear
          
        End If
      
       
        With Fe: Ligne = .Cells(.Rows.Count, 2).End(xlUp).Row: End With
      
       
        If Ligne = 1 And Fe.Cells(1, 1).Value = "" Then
            Fe.Range(Fe.Cells(1, 1), Fe.Cells(2, 26)).Value = FeBase.Range(FeBase.Cells(5, 2), FeBase.Cells(5, 26)).Value
        End If
      
      
        Fe.Range(Fe.Cells(Ligne + 1, 1), Fe.Cells(Ligne + 1, 25)).Value = FeBase.Range(Cel, Cel.Offset(, 24)).Value

    Next Cel
  
End Sub

 

[Theze]

Désolé mais sur ce coup, j'ai de la peine à comprendre :-((

-1) sur quelle(s) colonne(s) peut on identifier les doublons ?
-2) quelles sont les colonnes que tu veux récupérer, toutes ou certaines d'entre elles ?

 

[Theze]

Bonjour,

Je te propose une autre solution, tu colles le code ci-dessous dans le module de la feuille (pas dans le module standard) et dans la feuille "PENALITE", tu vas utiliser la colonne Y (25 ème colonnes que tu peux nommer "Transfert" mais ça n'a aucune importance) afin de transférer les valeurs.
Je m'explique, quand tu vas renseigner ta ligne, tu vas commencer, je suppose, par la colonne A ou même B et tu te déplace vers la droite jusqu'à la fin de ta base et bien une fois tous les champs renseignés, tu entres la valeur 1 dans la colonne Y sur la même ligne et tu valides ce qui va transférer la ligne dans la feuille concernée (elle sera créée si elle n'existe pas).
Si ta base n'est pas trop grande pour l'instant, il te suffit d'entrer les valeurs 1 dans chaque cellule de la colonne Y ce qui va créer les feuilles si elles n'existent pas et transférer les valeurs de chaque ligne :

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim FeBase As Worksheet
    Dim Fe As Worksheet
    Dim Ligne As Long

    If Target.Count > 1 Then Exit Sub 'suite à une sélection multiple et suppression par exemple
    If Target.Column <> 25 Then Exit Sub 'colonne Y
    If Target.Row < 6 Then Exit Sub 'pas les lignes d'entêtes
   
    'si la valeur est 1, on lance le transfert
    If Target.Value = 1 Then
   
        Set FeBase = Worksheets("PENALITE")
   
        On Error Resume Next
        Set Fe = Worksheets(Cells(Target.Row, 2).Value)
   
        If Err.Number <> 0 Then
           
            gèle l 'affichage
            Application.ScreenUpdating = False
           
            Set Fe = Worksheets.Add(, Sheets(Sheets.Count))
            Fe.Name = Cells(Target.Row, 2).Value
            Err.Clear
           
            're-sélectionne la feuille car la création mets le focus sur la nouvelle feuille
            FeBase.Select
           
            'rafraîchi
            Application.ScreenUpdating = True
   
        End If
       
        'transfert
        With Fe: Ligne = .Cells(.Rows.Count, 2).End(xlUp).Row: End With
   
        If Ligne = 1 And Fe.Cells(1, 2).Value = "" Then
            Fe.Range(Fe.Cells(1, 1), Fe.Cells(2, 23)).Value = FeBase.Range(FeBase.Cells(5, 2), FeBase.Cells(5, 24)).Value
        End If
   
        Fe.Range(Fe.Cells(Ligne + 1, 1), Fe.Cells(Ligne + 1, 23)).Value = FeBase.Range(FeBase.Cells(Target.Row, 2), FeBase.Cells(Target.Row, 24)).Value
   
    End If
   
End Sub

 

[Brudy]

Bonjour à toi Theze,

merci pour le temps que tu passe à me trouver une solution,

J'ai essayer d'appliquer ton code mais cela ne semble pas fonctionner comme d'habitude. Quand tu dis que je dois le mettre dans le module de la feuille et pas en standard c'est à dire ? Finalement j'ai compris, cependant le code m'annonce une erreur de compilation (Sub ou fonction non définie) :/

Ok finalement il manquait juste une ' sur une explication... Je test tout ça et je reviens

Malgré que cela soit une base conséquente, les lignes doivent être vérifiés une par une alors parfait pour la validation en fin de ligne !

J'ai encore du boulot mais déjà pouvoir modifier les ranges d'une macro et ce retrouver dans un code c'est appréciable

PS 9h24: Je suis entrain d'essayer de modifier la cellule de collage mais j'échoue, j'arrive bien à décaler la ligne de collage des entêtes mais pas le reste , c'est du à l'utilisation du +1 je suppose ?
J'aimerais pouvoir faire des stats au dessus de la bdd entrepot, c'est pour ça que j'aimerais que ça débute plus bas

 

[Brudy]

Ok c'est bon je me suis dépatouiller avec cette partie !

Merci Theze !