Recopie de lignes selon critère

[almas]

Bonjour amis du forum

J’ai un nouveau problème de code VBA
J’ai recherché sur le forum et trouvé plein de code qui fond partiellement ce que je veux mais je n’arrive pas à les adapter pour mon objectif.

Je veux « simplement 😛 »recopier les lignes d’une base sur d’autres onglets en fonction d’un critère.

Seulement il faut que la mise en forme et mise en page reste sur les autres onglets (pour la gestion des couleurs et une impression rapide)

La macro peut s’effectuer à l aide d’un bouton

J’ai testé plusieurs codes qui créent des onglets directement mais la mise en page ne reste pas ou alors il reprend que les données mais pas les couleurs.

Je vous remercie d’avance de regarder si ma requête est faisable.

Bonne journée à tous

 

[job75]

Re : Recopie de lignes selon critère

Bonjour almas,

Problème vraiment très classique.

Voyez le fichier joint avec cette macro dans ThisWorkbook :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim a, h&
a = Array("Recapitulatif", "Donnée") 'feuilles a exclure
If IsNumeric(Application.Match(Sh.Name, a, 0)) Then Exit Sub
Application.ScreenUpdating = False
Sh.AutoFilterMode = False 'désactive le filtre
Sh.Rows("7:" & Rows.Count).Delete 'RAZ
Sheets("Recapitulatif").Visible = True
Sheets("Recapitulatif").Copy 'nouveau document
ActiveSheet.AutoFilterMode = False 'désactive le filtre
h = Range("A" & Rows.Count).End(xlUp).Row - 5
If h > 0 Then
  With [6:6].Resize(h)
    .AutoFilter 1, Sh.Name 'filtre automatique
    .Offset(1).SpecialCells(xlCellTypeVisible).Copy Sh.[A7]
  End With
End If
ActiveWorkbook.Close False 'ferme le document
End Sub

Elle s'exécute quand une feuille est activée.

Nota : un document auxiliaire est créé pour éviter de supprimer le filtre de la feuille "Recapitulatif" quand il est en place.

Edit : sur mon ordi (Excel 2003) il faut enregistrer le fichier avant de le tester.

A+

 

[Jack2]

Re : Recopie de lignes selon critère

Bonjour almas, Bonjour job75,

Une solution où toutes les informations sont copiées en une seule fois. Le filtre est conservé.

Sub Recopie()
Dim i As Integer
Dim Onglet As String
Dim Der As Integer, Fin As Integer
Dim j As Integer

Sheets("Recapitulatif").Select
Application.ScreenUpdating = False
Der = Range("A" & Rows.Count).End(xlUp).Row
For i = 7 To Der
    Onglet = CStr(Range("A" & i))
    For j = 1 To Sheets.Count
        If Onglet = Sheets(j).Name Then
            Fin = Sheets(j).Range("A" & Rows.Count).End(xlUp).Row + 1
            If Fin < 7 Then Fin = 7
            Range("A" & i & ":BP" & i).Copy Destination:=Sheets(j).Range("A" & Fin & ":BP" & Fin)
            GoTo Suite
        End If
    Next j
Suite:
Next i
Application.ScreenUpdating = False
End Sub

With [6:6].Resize(h)
.AutoFilter 1, Sh.Name 'filtre automatique
.Offset(1).SpecialCells(xlCellTypeVisible).Copy Sh.[A7]
End With

Faut que je m'inspire de ce passage pour rendre le code plus compact.

A+ Jack2

 

[job75]

Re : Recopie de lignes selon critère

Re, salut Jack2,

J'avais fait une erreur bête pour le calcul de h, j'ai corrigé le post #2 😡

Bonne fin de soirée.

 

[almas]

Re : Recopie de lignes selon critère

re
GRAND Merci à tous les 2😀

JOB: j 'ai tester ton code dans tous les sens cela marche parfaitement (copier coller de nouvelles lignes ou insertion mise à jour immédiate).Les formes et format sont bien respectés.Du coup je comprend pas tes commentaires:

Elle s'exécute quand une feuille est activée.

Nota : un document auxiliaire est créé pour éviter de supprimer le filtre de la feuille "Recapitulatif" quand il est en place.

Edit : sur mon ordi (Excel 2003) il faut enregistrer le fichier avant de le tester.

Jack: je n 'arrive pas a faire fonctionner ton code??? il doit être copier ou?

 

[Jack2]

Re : Recopie de lignes selon critère

Bonjour tout le monde,

Autre erreur bête, j'ai mis Der au lieu de i dans Range.copy😡. Corrigé dans le post n°3.

Pour le code aller dans dans Visual Basic (Alt + F11) et le mettre dans un module. Comme je le disais, le code ne me convient pas avec une double boucle. Dès que j'ai le temps je corrige.🙂

EDIT Pour que ça fonctionne, il, ne faut pas qu'il y ait de formules dans les tableaux des onglets DGS, ou alors prévoir comme Job une ligne qui nettoie (RAZ)

A+ Jack2

 

[job75]

Re : Recopie de lignes selon critère

Bonjour almas, le forum,

Mes commentaires sont pourtant tout ce qu'il y a de plus clairs !!

Chez moi, si je teste en ligne le fichier joint du post #2, Excel m'envoie des messages relatifs aux noms définis dans la feuille "Donnée".

C'est pour cela que je dis qu'il faut enregistrer le fichier (sur le bureau par exemple) avant de tester.

A+

 

[job75]

Re : Recopie de lignes selon critère

Re,

Par curiosité, dans la feuille "Recapitulatif", j'ai recopié les lignes 7:23 jusqu'à la ligne 8506.

La macro s'exécute en 3 ou 4 secondes, ce qui est assez long.

Je vais essayer de voir si l'on peut faire mieux.

A+

 

[job75]

Re : Recopie de lignes selon critère

Re,

J'ai testé avec cette macro, mais c'est un peu moins rapide qu'avec le filtre automatique :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim a, h&
a = Array("Recapitulatif", "Donnée") 'feuilles a exclure
If IsNumeric(Application.Match(Sh.Name, a, 0)) Then Exit Sub
Application.ScreenUpdating = False
Sh.AutoFilterMode = False 'désactive le filtre
Sh.Rows("7:" & Rows.Count).Delete 'RAZ
Sheets("Recapitulatif").Visible = True
Sheets("Recapitulatif").Copy 'nouveau document
ActiveSheet.AutoFilterMode = False 'désactive le filtre
h = Range("A" & Rows.Count).End(xlUp).Row - 6
If h > 0 Then
  With [IV7].Resize(h) 'colonne auxiliaire
    .FormulaR1C1 = "=LN(RC1=""" & Sh.Name & """)"
    .Value = .Value 'supprime les formules
    .EntireRow.Sort .Cells, xlAscending, Header:=xlNo 'tri pour accélérer
    On Error Resume Next 'si aucune valeur d'erreur
    .SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete
    .ClearContents
    .EntireRow.Copy Sh.[A7]
  End With
End If
ActiveWorkbook.Close False 'ferme le document
End Sub

A+

 

[almas]

Re : Recopie de lignes selon critère

Merci pour vos réponses

Job j 'ai pourtant testes sans enregistrer (je suis sous 2003 également ) et depuis j 'ai appliqué ton code à mon fichier original et ça marche parfaitement . Je n 'ai eu qu ' un petit souci, c 'est qu' il me recopie également toute les lignes ou la cellule de la colonne référence est vide. Mon fichier fichier a environ 200 lignes , c 'est donc pratiquement instantané quand je clic sur l' onglet.
édit: merci pour ce new code je vais plus savoir le quelle prendre a la fin MDR😛
édit2: marche pas ce code chez moi :erreur 1004 probleme de fusion de cellule et me créé un new classeur a chaque fois

Jack je maitrise pas bien le code VBA mais quand même j 'aurai du me douter que si c 'était pas dans le ThisWorkbook c’était forcement à copier dans un module 😛 dsl
ça marche bien également.Par contre je ne vois pas quel différence il y a entre vos 2 codes (peut être que la mise à jour des onglets ne ce fait pas quand on les sélectionne pour le tien? d’ailleurs je n 'arrive pas à la faire🙂 )

 

[job75]

Re : Recopie de lignes selon critère

Re,

Juste une remarque sur le code de Jack2 :

Der = Range("A" & Rows.Count).End(xlUp).Row

renvoie la dernière ligne visible du tableau.

Si la feuille "Recapitulatif" est filtrée, toutes les lignes ne sont donc pas étudiées...

A+

 

[job75]

Re : Recopie de lignes selon critère

Re,

Je n 'ai eu qu ' un petit souci, c 'est qu' il me recopie également toute les lignes ou la cellule de la colonne référence est vide.

C'est quoi cette colonne référence ?

S'il s'agit d'un 2ème critère de filtrage c'est nouveau, mais c'est facile de l'ajouter.

PS : mon 2ème code (post #9) est sans intérêt puisqu'il n'est pas plus rapide que le 1er.

A+

 

[Jack2]

Re : Recopie de lignes selon critère

Re Bonjour tout le monde,

Le code que j'ai proposé traite tous les onglets à la fois à partir de la feuille "Recapitulatif" (tu peux mettre un bouton dans cette feuille pour appeler la macro).

Celui de JOB s'exécute lorsque tu actives un onglet (cf. post n°2). Chaque fois que tu cliques sur l'onglet DGS, toutes les données de cette feuille sont actualisées automatiquement à partir de la feuille "Recapitulatif". Pareil pour les autres. De plus (Post n°8), JOB tient compte des valeurs filtrées qui ne sont pas visibles.

Ca fait deux choses à repenser pour mon code.

A+ Jack2

 

[almas]

Re : Recopie de lignes selon critère

c 'est beaucoup plus claire maintenant merci à tous les 2

Pour moi le code 1 de job est donc le plus approprié

JOB : j 'ai pas eu le temps de décortiqué ton code et donc je croyais que tu faisais référence à la colonne A du tableaux récapitulatif pour repartir les ligne dans les différend onglet et donc quand il n 'y a rien dans une cellule de cette colonne elle apparais dans tous les onglets
Mais apparemment tu dois faire autrement car je me suis aperçu que si un onglet existait (exemple DGS) mais que le tableaux ne contenais pas de ligne avec "DGS" j 'avais une erreur 1004 quand je cliquai sur l'onglet DGS.
j 'ai rajouter une ligne et plus de problème.

faut vraiment que je bosse le VBA pour mieux comprendre les codes.....😛

 

[job75]

Re : Recopie de lignes selon critère

Re,

je croyais que tu faisais référence à la colonne A du tableaux récapitulatif pour repartir les ligne dans les différend onglet et donc quand il n 'y a rien dans une cellule de cette colonne elle apparais dans tous les onglets.

Ou allez-vous chercher ça ? Quand une cellule en colonne A est vide sa ligne n'est copiée nulle part 😕

j 'ai rajouter une ligne et plus de problème.

Quel problème 😕 J'ai l'impression que vous jouez les apprentis sorciers, non ?

S'il n'y a pas de "DGS" en colonne A de "Recapitulatif", la feuille "DGS",quand on l'active, est vide à partir de la ligne 7.

A+