Macro copier des lignes sur une feuille pour les dispatcher sur d'autres feuilles

[adad]

Bonjour à tous,

J'ai longuement cherché une solution mais en vain
J'ai trouvé des choses comparables mais je n'arrive pas à les adapter à mon cas, je n'ai visiblement pas les compétences nécessaires.
Voici mon problème, j'espère que quelqu'un saura m'éclairer:
J'ai besoin de copier-coller des lignes d'une feuille "base de données" vers d'autres feuilles, selon leur région.
Je vous joins mon fichier pour plus de clarté:
Dans l'onglet "Base de données", il est indiqué une "région" en colonne L.
J'aimerais que chaque ligne se copie dans l'onglet correspondant à sa "région", et à partir de la ligne 15 (sous le tableau correspondant en fait) et que ces lignes apparaissent triées alphabétiquement par bailleur (colonne K) et par date de CF (colonne i).

Je ne pensais pas que ça serait si compliqué.
Merci par avance pour votre aide.

 

[Papou-net]

Re : Macro copier des lignes sur une feuille pour les dispatcher sur d'autres feuille

Bonjour adad, et bienvenue,

Vois si le fichier en retour répond à tes attentes.

Cordialement.

 

[adad]

Re : Macro copier des lignes sur une feuille pour les dispatcher sur d'autres feuille

Bonjour!

J'ai testé rapidement, ça m'a l'air de fonctionner, c'est extra!
Un immense merci à toi.
Je vois en arrivant au boulot si je parviens à l'adapter au fichier originel qui contient plus de colonnes et plus d'onglets (j'ai du le modifier pour le diffuser par souci de confidentialité mais aussi de taille du fichier qui était trop lourd).

Je te tiens au courant.
Et encore bravo!

 

[Papou-net]

Re : Macro copier des lignes sur une feuille pour les dispatcher sur d'autres feuille

Bonjour adad,

si je parviens à l'adapter au fichier originel qui contient plus de colonnes et plus d'onglets

Au vu des données de ton fichier, je me doutais bien qu'il s'agissait d'un condensé pour exemple.

J'ai donc anticipé une extension future dès la création de la macro. Elle peut traiter autant d'onglets que nécessaire, puisque la boucle analyse l'ensemble des feuilles et ignore les 3 premières. Le nombre de colonnes n'a aucune importance non plus car la copie concerne les lignes dans leur totalité.

Enfin, j'ai oublié de préciser que l'ordre des onglets n'a aucune importance.

Cordialement.

PS: j'ai considéré aussi que les lignes rayées ne devaient pas être recopiées.

 

[adad]

Re : Macro copier des lignes sur une feuille pour les dispatcher sur d'autres feuille

Vraiment top!

Par contre je ne parviens pas à copier la macro sur le fichier originel.
Pourrais-tu m'éclairer sur ce point stp?
Cordialement.

 

[cathodique]

Re : Macro copier des lignes sur une feuille pour les dispatcher sur d'autres feuille

Bonjour,

Désolé pour mon intrusion. à la recherche d'une solution sur le forum, je suis tombé sur votre discussion.

Je voudrai comprendre la signification de cette ligne de code

Feuil1.Rows("1:2").Copy Destination:=Feuille.Rows("1:2")

ou plutôt Rows("1:2")
Merci beaucoup.

 

[Papou-net]

Re : Macro copier des lignes sur une feuille pour les dispatcher sur d'autres feuille

RE:

Où essaies-tu de copier le code et quel est la nature du problème exactement?

Par quel moyen désires-tu lancer le code?

Par contre, ne tiens pas compte de la Macro1, c'était un test, et j'ai oublié de le supprimer.

A +

Cordialement.

 

[Papou-net]

Re : Macro copier des lignes sur une feuille pour les dispatcher sur d'autres feuille

Bonjour,

Désolé pour mon intrusion. à la recherche d'une solution sur le forum, je suis tombé sur votre discussion.

Je voudrai comprendre la signification de cette ligne de code

Feuil1.Rows("1:2").Copy Destination:=Feuille.Rows("1:2")

ou plutôt Rows("1:2")
Merci beaucoup.

Bonjour cathodique,

Ce code permet de copier les lignes 1 et 2 depuis "Feuil1" et de les coller sur les lignes 1 et 2 de la feuille "Feuille".

Cordialement.

 

[adad]

Re : Macro copier des lignes sur une feuille pour les dispatcher sur d'autres feuille

Encore merci Papou-net!

Je suis finalement parvenu à copier la matrice dans mon fichier (tant bien que mal mais ça marche).
Le seul petit problème que je n'arrive pas à résoudre, c'est que la macro recopie parfois les lignes barrées et parfois non.
L'idéal serait qu'elle copie les lignes dont la colonne J est en "Accord" et en "AVIS CF" et ne pas prendre celles en "Annulé", "Refus" et "Différé". J'imagine que c'est plus compliqué donc simplement recopier à chaque fois l'intégralité des lignes par région devrait faire l'affaire. Je ne peux malheureusement pas joindre le fichier qui est beaucoup trop lourd, en revanche, pourrais-tu s'il te plaît, m'indiquer comment procéder pour modifier ça? Et tes commentaires explicatifs sont les bienvenus, c'est très intéressant et très instructif, mais je pars de loin, très loin...

A bientôt et encore merci!


Sub CommandButton1_Click()
Dim Cel As Range, plg As Range, lsh As String, sh As Object

Application.ScreenUpdating = False
lsh = Feuil1.CodeName & "-" & Feuil2.CodeName & "-" & Feuil3.CodeName & "-" & Feuil17.CodeName
For Each sh In Sheets
If InStr(lsh, sh.CodeName) = 0 Then
For Each Cel In Me.Range("L5:L" & Rows.Count).SpecialCells(xlCellTypeConstants)
If Cel = sh.Name And Cel.Font.Strikethrough = False Then
If plg Is Nothing Then
Set plg = Cel.EntireRow
Else
Set plg = Application.Union(plg, Cel.EntireRow)
End If
End If
Next
plg.Copy sh.Range("A60")
Set plg = Nothing
With sh.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("K60:K" & Rows.Count), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("I60:I" & Rows.Count), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("A60:ip" & Rows.Count)
.Apply
End With
End If
Next
Application.ScreenUpdating = True
End Sub

 

[Papou-net]

Re : Macro copier des lignes sur une feuille pour les dispatcher sur d'autres feuille

Bonsoir adad,

Voici comment modifier le code pour tenir compte de tes critères.

Private Sub CommandButton1_Click()
Dim Cel As Range, plg As Range, lsh As String, sh As Object

'Désactive le rafraîchissement d'écran qui ralentit l'exécution
Application.ScreenUpdating = False
'la variable lsh stocke le nom système des feuilles qui ne sont pas concernées par la copie
'l'utilisation des noms système (CodeName) permet de modifier les noms des onglets sans incidence sur le code
lsh = Feuil1.CodeName & "-" & Feuil2.CodeName & "-" & Feuil3.CodeName
'La boucle passe en revue toutes les feuilles du classeur
For Each sh In Sheets
  'Si le nom de la feuille n'est pas contenu dans lsh les lignes suivantes s'y appliquent
  If InStr(lsh, sh.CodeName) = 0 Then
    'Cette boucle analyse toutes les cellules non vides de la colonne L, à partir de la ligne 5
    For Each Cel In Me.Range("L5:L" & Rows.Count).SpecialCells(xlCellTypeConstants)
      'Si la cellule contient le nom de la feuille en cours d'analyse et si la cellule correspondante en colonne J
      'contient un des critères entre guillemets
      If Cel = sh.Name And InStr("ACCORD, AVIS CF", UCase(Cel.Offset(0, -2))) > 0 Then
        'Si la plage de cellules plg est vide, elle récupère la ligne complète de lacellule en cours d'analyse
        'sinon elle ajoute les lignes des cellules suivantes
        If plg Is Nothing Then
          Set plg = Cel.EntireRow
          Else
          Set plg = Application.Union(plg, Cel.EntireRow)
        End If
      End If
    Next
    'Copie la plage plg et la colle à partir de la cellule A15
    plg.Copy sh.Range("A15")
    'Supprime la plage définie pour recommencer la boucle
    Set plg = Nothing
    'Opère le tri des lignes en fonction des colonnes Bailleur et Date
    With sh.Sort
      .SortFields.Clear
      .SortFields.Add Key:=Range("K15:K" & Rows.Count), SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortNormal
      .SortFields.Add Key:=Range("I15:I" & Rows.Count), SortOn:=xlSortOnValues, _
        Order:=xlAscending, DataOption:=xlSortNormal
      .SetRange Range("A15:R" & Rows.Count)
      .Apply
    End With
  End If
Next
'Rétablit le rafraîchissement d'écran
Application.ScreenUpdating = True
End Sub

A +

Cordialement.

 

[adad]

Re : Macro copier des lignes sur une feuille pour les dispatcher sur d'autres feuille

Merci Papou-net.

Tu m'as été d'une aide précieuse. J'ai maintenant très envie de comprendre mieux. Je vais me former sur le sujet.
Encore merci et bravo pour l'aide que tu apportes.
Cordialement.