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

 

[almas]

Re : Recopie de lignes selon critère

tu a un peut raison JOB....je bricole😉
mais j 'essais surtout (avec mes moyens) de comprendre le code...
effectivement je comprend pas pk quand j 'ai pas de "DGS" il me met "erreur 1004 pas de cellules correspondantes"
dès que je la remet ça remarche ....c'est pour cela que j 'ai fait ça...même si c 'est de la bricole^^

 

[job75]

Re : Recopie de lignes selon critère

Re,

Avec On Error Resume Next plus aucun problème s'il n'y a pas de cellule visible :

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
    On Error Resume Next 's'il n'y a pas de cellule visible
    .Offset(1).SpecialCells(xlCellTypeVisible).Copy Sh.[A7]
  End With
End If
ActiveWorkbook.Close False 'ferme le document
End Sub

Fichier (2) où j'ai effacé les "DGS" en colonne A.

A+

 

[job75]

Re : Recopie de lignes selon critère

Re,

Je viens seulement de me rendre compte qu'il y avait une erreur, il faut remplacer :

ActiveSheet.AutoFilterMode = False 'désactive le filtre

par :

ActiveWorkbook.Sheets(1).AutoFilterMode = False 'désactive le filtre

Donc utiliser :

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
ActiveWorkbook.Sheets(1).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

Fichier (3).

A+

 

[Jack2]

Re : Recopie de lignes selon critère

Bonne insomnie tout le monde,

En suivant la logique de JOB, toutes les feuilles traitées en même temps, ce qui n'apporte rien de bien nouveau, si ce n'est que la réponse est oui à la deuxième ligne du post n°14. Ca m'a permis de mieux comprendre ce code sauf cette instruction [6:6]. Si quelqu'un peut m'expliquer, ce sera avec plaisir.

J'ai vu que DoubleZero a mis un "likes this", ce qui ne m'étonne pas de la part du roi de l’escamotage, des colonnes temporaires et autres cachettes provisoires.

A+ Jack2

 

[job75]

Re : Recopie de lignes selon critère

Bonjour le fil, le forum,

Jack2, je ne comprends rien à ce que vous racontez sur DoubleZero, mais sachez qu'elle est est notre petite reine, que tout le monde l'adore et qu'elle se donne beaucoup de mal pour aider les gens tout en progressant elle-même.

A l'heure où vous avez posté vous étiez sans doute fatigué mais on attend cependant de vous des excuses.

Pour en terminer avec VBA voici une macro qui traite simultanément toutes les feuilles :

Sub MAJ_feuilles()
Dim a, h&, w As Worksheet
a = Array("Recapitulatif", "Donnée") 'feuilles a exclure
Application.ScreenUpdating = False
Sheets("Recapitulatif").Visible = True
Sheets("Recapitulatif").Copy 'nouveau document
ActiveWorkbook.Sheets(1).AutoFilterMode = False  'désactive le filtre
h = Range("A" & Rows.Count).End(xlUp).Row - 5
For Each w In ThisWorkbook.Worksheets
  If IsError(Application.Match(w.Name, a, 0)) Then
    w.AutoFilterMode = False 'désactive le filtre
    w.Rows("7:" & w.Rows.Count).Delete 'RAZ
    If h > 0 Then
      With [6:6].Resize(h) 'définit les lignes à filtrer
        .AutoFilter 1, w.Name 'filtre automatique
        .Offset(1).SpecialCells(xlCellTypeVisible).Copy w.[A7]
      End With
    End If
  End If
Next
ActiveWorkbook.Close False 'ferme le document
End Sub

Noter qu'un seul document auxiliaire est créé.

Fichier (4).

A+

 

[Jack2]

Re : Recopie de lignes selon critère

Bonjour tout le monde,

J'ai vu que DoubleZero a mis un "likes this", ce qui ne m'étonne pas de la part du roi de l’escamotage, des colonnes temporaires et autres cachettes provisoires

Job75. Il ne s'agit en aucun cas d'une critique de DoubleZero. Au contraire ! C'est dommage que cela ait été mal interprété. J’ai eu l'occasion à travers différents fils de lui faire remarquer et de souligner les astuces qu'il (qu'elle fait partager). C'est une des personnes que j'apprécie sur ce forum. La remarque que j'ai faite concerne sa faculté à trouver des astuces de type colonnes temporaires et autres.

Pour finir, Job75. Sache que sur ce forum d'entraide, je trouve qu'il serait mal venu de critiquer les bénévoles, quelles que soient les circonstances ou l'humeur du moment. J'espère que DoubleZero ne l'a pas mal pris et je tâcherai d'être plus clair la prochaine fois. Il est dommage qu'un compliment soit perçu comme une critique. C'est sur la formulation que je m'excuse, sur le fond il s'agissait d'un compliment.

A+ Jack2

 

[job75]

Re : Recopie de lignes selon critère

Re,

OK Jack2, n'en parlons plus, mais vous avez une drôle de façon de formuler vos compliments.

A+

 

[Jack2]

Re : Recopie de lignes selon critère

Je vais éviter ce type de malentendu

A+