Cherche Macro si c'est possible...

[FraggleRock26]

Bonjour à toutes et tous,

Je viens vous soumettre de nouveau une petite demande

Je ne peux pas joindre d'exemple en piéces jointes car le classeur est trop lourd pour l'uploader ici voici donc un lien pour le télécharger :


Alors dans mon classeur j'aimerais, si c'est possible, avoir une MACRO qui me permette de coller dans la feuille "RECAP", à la suite, toutes les données (des lignes dont la colonne N indique une date) des feuilles de "MArs/Avril" à "Nov-Dec", des colonnes "N" à "AO".

De façon à avoir sur ma feuille "RECAP" le récapitulatif, à la suite de toutes mes autres feuilles mois aprés mois...

Comme d'habitude j'ai crée une feuille "Recap que je voudrais" pour montrer le résultat espéré...

J’espère avoir été assez clair dans ma demande, et surtout que ce soit possible...

Merci d'avance

Bonne Journée

 

[sousou]

Re : Cherche Macro si c'est possible...

bonjour

tu peux essayer avec ce code
Pas très rapide, mais très simple à aménager
Sub recap()
Set lignes = New Collection
feuilles = Array("Mars-Avril", "Nov-Dec")

For n = 0 To UBound(feuilles)
l = 1
With Sheets(feuilles(n)).Cells(1, 14)
While .Offset(l, 0) <> ""
If IsDate(.Offset(l, 0)) = True Then
lignes.Add .Offset(l, 0).EntireRow
End If
l = l + 1
Wend
End With
Next

Call rangelignes(lignes)

End Sub

Sub rangelignes(lignes)
Set dest = Sheets("Recap").range("a2")
n = 0
For Each l In lignes
Set Z = l.Parent.range(l.Parent.Cells(l.Row, 14), l.Parent.Cells(l.Row, 14 + 28))
Z.Copy dest.Cells(n, 14)
n = n + 1
Next
End Sub

 

[FraggleRock26]

Re : Cherche Macro si c'est possible...

Merci Sousou,

J'ai du modifier la macro, il faut que je rajoute les mois : "Mai", "Juin", .... pour que cela trie tout et comme ça, ça à l'air de fonctionner.

C'est effectivement trés long par contre car ça le copie ligne aprés ligne, et comme sur chaque mois j'ai au moins une bonne centaine de lignes sur mon classeur, ça prends du temps, mais c'est mieux que rien

Si jamais quelqu'un à une macro qui fasse cela plus rapidement je suis preneur... Sinon je m'en contenterais bien.

Vous êtes trop fort...

Je les aurais un jour, je les aurais...

 

[FraggleRock26]

Re : Cherche Macro si c'est possible...

C'est bon cela fonctionne, j'avais mal orthographié le nom d'une feuille...

Mais toujours trés lent...

 

[sousou]

Re : Cherche Macro si c'est possible...

ajoute
Application.Calculation = xlCalculationManual
en début de programme
et
Application.Calculation = xlCalculationAutomatic
en fin de programme
La lenteur est due aux nombreuses formules

 

[Paf]

Re : Cherche Macro si c'est possible...

Bonjour,

l'utilisation de tableaux accélèrerait beaucoup l'exécution de la macro, mais le résultat attendu conserve la mise en forme (couleur des lignes) ce qui est incompatible avec les tableaux . cette mise en forme est elle nécessaire ?

A+

 

[JCGL]

Re : Cherche Macro si c'est possible...

Bonjour à tous,

Avec le code de Sousou à peine remanié :

Sub Recap()
    Set Lignes = New Collection
    Feuilles = Array("Mars-Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Nov-Dec")
    With Application
        .ScreenUpdating = 0
        .Calculation = xlCalculationManual
    End With
    For n = 0 To UBound(Feuilles)
        l = 1
        With Sheets(Feuilles(n)).Cells(1, 14)
            While .Offset(l, 0) <> ""
                If IsDate(.Offset(l, 0)) = True Then
                    Lignes.Add .Offset(l, 0).EntireRow
                End If
                l = l + 1
            Wend
        End With
    Next
    Call RangeLignes(Lignes)
    With Application
        .ScreenUpdating = 1
        .Calculation = xlAutomatic
    End With
End Sub


Sub RangeLignes(Lignes)
    Set dest = Sheets("Recap").Range("a2")
    n = 0
    For Each l In Lignes
        Set Z = l.Parent.Range(l.Parent.Cells(l.Row, 14), l.Parent.Cells(l.Row, 14 + 28))
        Z.Copy dest.Cells(n, 14)
        n = n + 1
    Next
End Sub

A+ à tous

 

[FraggleRock26]

Re : Cherche Macro si c'est possible...

Oui la mise en forme est nécéssaire, cela permet de différencier plus rapidement lorsque l'on passe d'un jour à un autre...

 

[FraggleRock26]

Re : Cherche Macro si c'est possible...

Bonjour JCGL,

Je n'arrive pas a intégrer cette macro, lorsque je tente de l'enregistrer il me marque "erreur de compilation" et il marque en rouge dans le code VBA ta premiére ligne avec le mot "Set" sélectionné...

 

[FraggleRock26]

Re : Cherche Macro si c'est possible...

Merci Sousou ça va un peu plus vite, je pense que ça ira comme ça...

Merci beaucoup encore une fois

 

[FraggleRock26]

Re : Cherche Macro si c'est possible...

Arffff je n'avais pas vu, mais lorsque je lance la macro, cela me met les résultats direct dans la ligne 1 et cela me supprime donc ma ligne d'intitulés que j'ai sur la feuille Recap.

Il faudrait que cela commence à me coller les réultats qu'à partir de la ligne 2.

Je vais faire des éssais voir si je trouve la solution tout seul...

 

[JCGL]

Re : Cherche Macro si c'est possible...

Bonjour à tous,

Remplace le n=0 par n=1

Sub RangeLignes(Lignes)
    Set dest = Sheets("Recap").Range("a2")
    n = 1

A+ à tous

 

[FraggleRock26]

Re : Cherche Macro si c'est possible...

Merci JCGL

 

[sousou]

Re : Cherche Macro si c'est possible...

Bonjour à vous deux
Je vois que tu es en de bonnes mains....
A+