macro tri mois d'une plage de date

[almas]

Bonjour le forum

j 'ai adapté un code à un de mes projets qui consiste à trier par mois une base de donnée avec une date de début et une date de fin
ca marche nikel......sauf quand la date de début n'a pas le même mois que celle de fin

il faut que je rajoute une fonction "ou" dans mon code et sans faire de doublon

ex: titre 12/01/2017 10/02/2017

je doit retrouver titre dans l onglet janvier et aussi dans l'onglet février et sans qu 'il soit 2 fois en janvier
et je n 'y arrive pas en VBA

je vous joint un fichier test ( le code s 'active quand on actualise la cellule A1 de chaque onglet par la liste)

 

[vgendron]

Hello

avant de modifier le code, il y a des choses que je ne comprend dedans..
1) qu'est censé faire ton code?
2) à quoi sert cette ligne?
Set plage = Sheets("Liste_manif").Range("Q1")
'Liste Manif est une zone nommée --> si oui. laquelle?

dans le fichier posté, il y a de nombreuses zones nommées dont les références ont été perdues..

 

[ChTi160]

Bonjour almas
Bonjour le Fil (vgendron),Le Forum
Une approche de ce que j'ai compris Lol
Attention aux Noms des Feuilles (accent éventuel)
Pourquoi ne pas remplir la zone de recherche lors de l'activation de la Feuille ?
Plutôt que par une liste à un Nom (Mois)
Bonne journée

 

[vgendron]

Une idée de code. si le besoin est bien de dispatcher ta feuille "Liste_Manif" dans les autres

Sub dispatch()
Dim tablo() As Variant

tablo = Sheets("Liste_manif").Range("A1").CurrentRegion.Offset(1).Value  'on place les data dans un tablo--->offset(1) pour éviter la ligne de titre
For i = LBound(tablo, 1) To UBound(tablo, 1)  'sur chaque ligne du tablo
    MoisDebut = Month(tablo(i, 2)) 'on récupère la date de début
    MoisFin = Month(tablo(i, 3))   'on récupère la date de fin
    For IndiceMois = MoisDebut To MoisFin
        mois = UCase(MonthName(IndiceMois)) 'on récupère le mois en lettre
        For Each ws In Worksheets
            If UCase(ws.Name) = mois Then
                With Sheets(mois)
                    .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0) = tablo(i, 1)
                    .Range("B" & .Rows.Count).End(xlUp).Offset(1, 0) = tablo(i, 4)
                    .Range("C" & .Rows.Count).End(xlUp).Offset(1, 0) = tablo(i, 5)
                End With
            End If
        Next ws


    Next IndiceMois
Next i

End Sub

 

[vgendron]

Hello Chti ! raffraichi juste après

petite modif de code

Sub dispatch()
Dim tablo() As Variant

tablo = Sheets("Liste_manif").Range("A1").CurrentRegion.Offset(1).Value  'on place les data dans un tablo--->offset(1) pour éviter la ligne de titre
For i = LBound(tablo, 1) To UBound(tablo, 1) - 1 'sur chaque ligne du tablo
    MoisDebut = Month(tablo(i, 2)) 'on récupère la date de début
    MoisFin = Month(tablo(i, 3))   'on récupère la date de fin
    For IndiceMois = MoisDebut To MoisFin
        mois = UCase(MonthName(IndiceMois)) 'on récupère le mois en lettre
        flag = 0
        For Each ws In Worksheets
            If UCase(ws.Name) = mois Then
                flag = 1
                With Sheets(mois)
                    .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0) = tablo(i, 1)
                    .Range("B" & .Rows.Count).End(xlUp).Offset(1, 0) = tablo(i, 4)
                    .Range("C" & .Rows.Count).End(xlUp).Offset(1, 0) = tablo(i, 5)
                    Exit For
                End With
            End If
        Next ws
        If flag = 0 Then MsgBox "la feuille: " & mois & " n'existe pas"


    Next IndiceMois
Next i

End Sub

 

[almas]

Bonjour ChiTI160 et vgendron et merci vos 2 réponses marche parfaitement avec une approche différente
Vgendron:

1) qu'est censé faire ton code?
2) à quoi sert cette ligne?
Set plage = Sheets("Liste_manif").Range("Q1")
'Liste Manif est une zone nommée --> si oui. laquelle?

en faite je réutilisais un code qui faisais une recherche sur plusieurs onglet et la "set plage" était la liste de tous les onglet ou il fallait chercher
j 'ai pas chercher à rectifier le code j 'ai donc refait une liste de 1 nom

ton code est le plus simple car aucune autre ligne de code dans aucune feuil et tu extrais directement le moi en texte sans passé par une autre colonne avant
mettre les titre de colonne en tableau je maitrise pas du tous mais c 'est génial

Chiti160:
j 'avais prévu de faire actualisé à la sélection de l onglet mais j 'ai laisser la sélection manuelle pour l instant

sinon vos approche avec un seul code a activer comme on veux marche parfaitement
je vais les décortiquer et je vous remercie encore

 

[vgendron]

Re modif pour effacer les feuilles mensuelles avant de recoller les infos

Sub dispatch()
Dim tablo() As Variant
For Each ws In Worksheets 'on efface les différentes feuilles
    If ws.Name <> "Liste_manif" Then
        ws.Range("A6").CurrentRegion.Offset(1).ClearContents
    End If
Next ws

tablo = Sheets("Liste_manif").Range("A1").CurrentRegion.Offset(1).Value  'on place les data dans un tablo--->offset(1) pour éviter la ligne de titre
For i = LBound(tablo, 1) To UBound(tablo, 1) - 1 'sur chaque ligne du tablo
    MoisDebut = Month(tablo(i, 2)) 'on récupère la date de début
    MoisFin = Month(tablo(i, 3))   'on récupère la date de fin
    For IndiceMois = MoisDebut To MoisFin
        mois = UCase(MonthName(IndiceMois)) 'on récupère le mois en lettre
        flag = 0
        For Each ws In Worksheets
            If UCase(ws.Name) = mois Then
                flag = 1
                With Sheets(mois)
                    .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0) = tablo(i, 1)
                    .Range("B" & .Rows.Count).End(xlUp).Offset(1, 0) = tablo(i, 4)
                    .Range("C" & .Rows.Count).End(xlUp).Offset(1, 0) = tablo(i, 5)
                    Exit For
                End With
            End If
        Next ws
        If flag = 0 Then MsgBox "la feuille: " & mois & " n'existe pas"
    Next IndiceMois
Next i
End Sub

 

[almas]

excellent je m 'en aurai pas spécialement aperçut de-suite car la base de donnée va en grandissant et donc les liste auraient été de plus en plus grandes

par contre mettre la base de donnée en tableau je découvre et je me régale!!!!

 

[almas]

a non l' effacement marche pas en faite ^^ il réécris en dessous de la dernier ligne utilisé et ça décale tous le tableau
je vais regarder ça de prêt

 

[vgendron]

Vérifie la zone détectée (et effacée) avec cette ligne, en mode pas à pas
en ayant ajouté

.activate
ws.Range("A6").CurrentRegion.Offset(1).select
ws.Range("A6").CurrentRegion.Offset(1).ClearContents

 

[almas]

le .activate il aime pas !^^
le ws.Range("A6").CurrentRegion.Offset(1).Select non plus
mais ca c 'est quoi ?CurrentRegion.Offset(1) tu l' a définis quelque par?

 

[almas]

je joint un fichier avec ton code

j 'ai mis un bouton "Dispatch" dans liste manif pour lancer ton code

avec ce code ca marche:
For Each ws In Worksheets 'on efface les différentes feuilles
If ws.Name <> "Liste_manif" Then
ws.Range("A7:C2000").ClearContents
End If

mais si je décide d 'afficher 4 colonne de mon tableau au lieux de trois faudra que je modifie mon code a cette endroit

 

[vgendron]

remplace le début du code par ceci

For Each ws In Worksheets 'on efface les différentes feuilles
    If ws.Name <> "Liste_manif" Then
            'ws.Range("A6").CurrentRegion.Offset(1).ClearContents
            ws.Range("A7:C" & Range("A" & Rows.Count).End(xlUp).Row).ClearContents
    End If
Next ws

 

[vgendron]

euh non. par ca en fait

For Each ws In Worksheets 'on efface les différentes feuilles
    If ws.Name <> "Liste_manif" Then
        With ws
            If .Range("A" & .Rows.Count).End(xlUp).Row <> 6 Then
                .Range("A7:C" & .Range("A" & .Rows.Count).End(xlUp).Row).ClearContents
            End If
        End With
    End If
Next ws

 

[almas]

nikel ! merci je peut avoir plus de 2000 lignes maintenant ^^

ca change quoi ton 2eme code?