Aide sur Macro génération auto

ddm

XLDnaute Junior
Salut

J'ai besoin de votre aide sur Marco de création automatique d'un tableau

ci-jonit un extrait de mon fichier

Merci d'avance
Cordialement
 

Pièces jointes

  • Exemple.xls
    33 KB · Affichages: 65
  • Exemple.xls
    33 KB · Affichages: 63
  • Exemple.xls
    33 KB · Affichages: 59

phlaurent55

Nous a quittés en 2020
Repose en paix
Re : Aide sur Macro génération auto

Bonjour ddm,

ton fichier en retour
à adapter car je suppose que le tableau de la feuille1 va s'étendre vers la droite

à+
Philippe
 

Pièces jointes

  • 111.xls
    48.5 KB · Affichages: 58
  • 111.xls
    48.5 KB · Affichages: 68
  • 111.xls
    48.5 KB · Affichages: 58

ddm

XLDnaute Junior
Re : Aide sur Macro génération auto

Bonjour Philippe;

Est-ce que c'est possible de créer le tableau de la feuille N°2, on gardant son format actuel

veuillez trouver ci-joint le fichier

Merci
 

Pièces jointes

  • ddm Tab.xls
    48 KB · Affichages: 54

job75

XLDnaute Barbatruc
Re : Aide sur Macro génération auto

Bonsoir ddm, salut Philippe,

La macro :

Code:
Sub Filtre()
Dim plage As Range
Application.ScreenUpdating = False
With Sheets("Feuil1")
  .AutoFilterMode = False
  .[A4:A5].AutoFilter Field:=13, Criteria1:=">0"
  Set plage = Intersect(.AutoFilter.Range, Union(.[A6:B65536], .[M6:N65536]))
  Set plage = plage.SpecialCells(xlVisible)
  With Sheets("Feuil2")
    .[A3:D65536].Clear
    plage.Copy .[A3]
  .Activate 'facultatif
  End With
  .AutoFilterMode = False
End With
End Sub

Fichier joint.

A+
 

Pièces jointes

  • Exemple(1).zip
    16 KB · Affichages: 34
  • Exemple(1).zip
    16 KB · Affichages: 34
  • Exemple(1).zip
    16 KB · Affichages: 33

job75

XLDnaute Barbatruc
Re : Aide sur Macro génération auto

Re,

Maintenant la macro adaptée au fichier du post #4 :

Code:
Sub Filtre()
Dim plage As Range, h As Long
Application.ScreenUpdating = False
With Sheets("Feuil1")
  .AutoFilterMode = False
  .[A4].AutoFilter Field:=.[Plage2].Column, Criteria1:=">0"
  Set plage = Union(.[Plage1], .[Plage2]).SpecialCells(xlVisible)
  h = Intersect(plage, .[A:A]).Cells.Count
  .AutoFilterMode = False
End With
With Sheets("Feuil2")
  On Error Resume Next
  .[B5:F5].Resize(Application.CountA(.[B:B]) - 3).Delete xlUp
  On Error GoTo 0
  .[B6:F6].Resize(h).Copy
  .[B5:F5].Insert xlDown
  plage.Copy .[B5]
  With .[B5:F5].Resize(h)
    .Borders.Weight = xlThin 'ou autrement :
    '.Borders(xlInsideVertical).Weight = xlThin
    .Borders(xlInsideHorizontal).LineStyle = xlNone
    .FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(LIGNE();2)=0"
    .FormatConditions(1).Interior.ColorIndex = 15
  End With
  .Activate 'facultatif
End With
End Sub

Noter la création d'une MFC pour la couleur alternée des lignes.

Et voir dans la feuille de calcul les définitions des noms Plage1 et Plage2.

Fichier joint.

A+
 

Pièces jointes

  • ddm Tab(1).zip
    17.2 KB · Affichages: 34
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 622
Messages
2 090 273
Membres
104 479
dernier inscrit
Guengant