XL 2016 Dissocier des ranges sur plusieurs Feuille selon condition

[Reda14]

Bonjour,

Je me présente je m'appel Reda et je suis nouveau dans le forum qui m'a beaucoup aidé jusqu'ici.

J'ai un problème en vba/macro que je n'arrive pas à résoudre malheureusement malgré mon bagage vba (appris à la fac), sur le fichier joint, qui est un fichier que j'incrémente chaque mois avec 10 lignes (toujours les mêmes libellés mais pas les mêmes valeurs bien sur).
Ce que je souhaite de faire est un code de macro / vba qui en fonction d'un seul SEUIL (la cellule en rouge dans le fichier) si il est supérieur à 2,5 je veux qu'il me mette les 10 lignes de ce mois sur une nouvelle feuille, sinon qu'il garde les 10 lignes sur la feuille de début (en sachant que le seuil du mois prochain sera 16 lignes en dessous du précedent) .

J’espère vous avez bien compris ma demande, sur le fichier y'a le code macro mais qui marche pas vraiment car je veux qu'il fasse sa pour tout les autres mois dans le fichier... je vous pris de jeter un coup d'oeil voir si vous pouvez m'aidez...
Merciii
Reda

 

[Staple1600]

Bonjour le fil, Reda14

Une macro qui peut-être t'inspirera quelque autre code pour ton projet
A tester quand c'est la feuille Base qui est active

Sub Macro_de_Test()
Dim Rng As Range, c As Range
seuil = 2.56
Set Rng = Columns("D:D").SpecialCells(xlCellTypeConstants, 1)
For Each c In Rng
MsgBox c.CurrentRegion.Address
MsgBox "Valeur du seuil:" & c.CurrentRegion.Item(12, 2)
MsgBox c.CurrentRegion.Item(12, 2) > seuil
Next
End Sub

NB: Ce n'est qu'une macro de test
(pas une solution)

 

[Reda14]

Merci Staple1600 pour ta réponse rapide, j'ai changé ma macro selon le code que tu m'a donné et c dèja mieux !
Ci-joint le nouveau fichier, il me donne bien une nouvelle feuille a chaque fois le foreach est exécuté sauf que pour chaque feuille y'a une ligne qui disparaît, ensuite je veux qu'une fois la 1er feuille est crée avec les 15 premières lignes, qu'il passe aux autres 15 lignes en dessous et ça j'y arrive pas.. ainsi que la valeur de mon seuil augmente a chaque fois...?

merci

 

[Staple1600]

Re

Tu as bien testé mon code (tel quel) en étant sur la feuille Base?
Parce que lors de mon test, je passe bien de "bloc en bloc", non ?
Ci-dessous les blocs en question et la valeur du seuil correspondant au bloc
A$2:$D$16|2,56
$A$18:$D$32|3,4
$A$34:$D$48|1,45
$A$50:$D$64|2,74

NB: Encore une fois, ma macro n'a comme vocation de peut-être te donner des idées.
Ce n'est pas une solution à ta question

(Et j'ai pas trop le temps de la creuser pour le moment, car j'ai Nadal sur ma TV )

 

[Reda14]

Ree

Oui je l'ai bien testé et la comparaison avec le seuil (2.5) elle fonctionne.
j'ai rajouter des lignes de codes (voir en dessous), puisque je veux qu'a chaque fois il est supérieur à mon seuil il me prend la selection et il l'a met dans une nouvelle feuille excel ( c'est ce qu'il fait pour la première selection) ensuite quand il passe à la seconde selection (qui est TRUE aussi) le programme s'arrete il y'a une erreur juste après la ligne du IF (en gras) :
'
Dim Rng As Range, c As Range
seuil = 2.5
Set Rng = Columns("D").SpecialCells(xlCellTypeConstants, 1)
For Each c In Rng
MsgBox c.CurrentRegion.Address
MsgBox "Valeur du seuil:" & c.CurrentRegion.Item(12, 2)
MsgBox c.CurrentRegion.Item(12, 2) > seuil

If True Then
c.CurrentRegion.Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
Else
Exit For
End If

Next
End Sub


j'ai l'impréssion il reste juste quelques détails avant que je trouve la solution miracle !!!

 

[Staple1600]

Bonsoir

Voici une façon de régler ces quelques détails
(Test OK sur la base de ton exemple, donc fonctionnel avec cette disposition de données sur la feuille Base)

Sub Macro_de_Test_II()
Dim Rng As Range, c As Range
seuil = 2.56
Application.ScreenUpdating = False
Set Rng = Sheets("Base").Columns("D:D").SpecialCells(xlCellTypeConstants, 1)
For Each c In Rng
If c.CurrentRegion.Item(12, 2) > seuil Then
c.CurrentRegion.Copy Sheets.Add(after:=Sheets(Sheets.Count)).Cells(1)
ActiveSheet.Name = "SEUIL_" & Format(c, "ddmmyyyy")
Application.CutCopyMode = False
End If
Next
End Sub

 

[Reda14]

Re bonsoir,

Mille merci ça marche à la perfection !!!

Si par exemple le nombre de mes lignes changent (si j'ai 20 lignes pour chaque mois à la place de 15) qu'est ce que je dois changer dans le code?

encore une fois mille merci!!!
reda

 

[Staple1600]

Re

La réponse est dans la question
Tentes ta chance, ajoutes des lignes dans tes "tableaux"
Et tu verras bien si la macro doit être adapté ou pas

Mais garde en mémoire la seconde phrase de mon précédent message
(qui à mon avis,n'est peut-être pas là, par hasard )

 

[Reda14]

Ree,

Bien vu ! elle n'est vraiment pas la par hasard !

Merci encore une fois ta été au top !
Reda

 

[Staple1600]

Re

Macro modifiée si le nombre de ligne n'est pas figé.
[phrase point ici par hasard]
Il faut qu'il y ait toujours une ligne de séparation entre les différents tableaux
ex: sur la feuille Base, la ligne 19 est vide
[/phrase]

Sub Macro_de_Test_III()
Dim Rng As Range, c As Range, x&, y&
seuil = 2.56
Application.ScreenUpdating = False
Set Rng = Sheets("Base").Columns("D:D").SpecialCells(xlCellTypeConstants, 1)
For Each c In Rng
x = c.CurrentRegion.Rows.Count
y = Application.Match("SEUIL", c.CurrentRegion(1).Resize(x), 0)
If c.CurrentRegion.Item(y, 2) > seuil Then
c.CurrentRegion.Copy Sheets.Add(after:=Sheets(Sheets.Count)).Cells(1)
ActiveSheet.Name = "SEUIL_" & Format(c, "ddmmyyyy")
Application.CutCopyMode = False
End If
Next
End Sub

PS: Macro basique (qui peut ne pas être 100% efficiente à l'usage)
Mais c'est déjà cela

 

[Reda14]

Re après une longue journée de travail

Merci pour ton dernier code! sur l'ancien fichier sa fonctionne mais hélas nouvelle complication. quand j'extrait les données et je les colles sur la feuille BASE j'ai des lignes vides (lignes 7 et 14 (voir fichier ci-joint)). quand j’exécute donc le dernier code il me sort une erreur : type mismatch dans :
y = Application.Match("SEUIL", c.CurrentRegion(1).Resize(x), 0)
je me suis renseigné du coup, n'est-il pas possible de selectionner par exemple les 17lignes de ma premières dates et les exporter sur une autre feuille excel si le seuil est > 2.5 ?
j'ai essayer de mettre la ligne y=Applicat.... en commentaire et faire le if de départ : If c.CurrentRegion.Item(14, 2) > seuil Then
donc sans utiliser le x et y ==> y'a pas de beug dans le programme il marche sauf qu'il me créer des feuilles à l'infini et dans chaque feuille il n y'a que 4 lignes et pas les 17lignes de la date voulu

Merci a toi ! je sais ce elle n'est pas 100% efficiente à l'usage malgré bricolage de la macro..

 

[Reda14]

J'ai oublié de mettre le fichier trop de fatigue..

 

[Staple1600]

Bonsoir

J'avais testé mon dernier code sur ton précédent fichier (et en me basant sur sa structure et sur la disposition des données)
Puis j'avais inséré les lignes dans les blocs pour déplacer la cellule SEUIL dans chaque bloc
(d'ou l'emploi de x et y)
Et au final, le test fonctionna, j'ai donc publié la macro.

A toi de voir ce que tu as changé entre le 1er fichier et le second

 

[Staple1600]

Re


Pour être sûr de dormir du sommeil du juste, j'ai refait un test
(donc sur des blocs ou la cellule SEUIL n'est jamais au même endroit dans le bloc)
Test toujours OK
NB: J'ai fait quelques petits changements.

Sub Macro_de_Test_IV()
Dim Rng As Range, c As Range, p As Range, x&, y&
seuil = 2.56
Application.ScreenUpdating = False
Set Rng = Sheets("Base").Columns("D:D").SpecialCells(xlCellTypeConstants, 1)
For Each c In Rng
Set p = c.CurrentRegion
x = p.Rows.Count
  If IsError(Application.Match("SEUIL", p(1).Resize(x), 0)) Then
  Exit Sub
  Else
  y = Application.Match("SEUIL", p(1).Resize(x), 0)
  End If
If p.Item(y, 2) > seuil Then
p.Copy Sheets.Add(after:=Sheets(Sheets.Count)).Cells(1)
ActiveSheet.Name = "SEUIL_" & Format(c, "ddmmyyyy")
Application.CutCopyMode = False
End If
Set p = Nothing
Next
End Sub

 

[Reda14]

Ree,

Mdr pour dormir la conscience tranquille j'ai essayé sur mon fichier et ça marche ! demain je le ressaye sur le fichier excel que je dois rendre pour voir ce que ça donne (le fichier de base contient des espaces entres les lignes) donc je vais essayer de le bosser et tt modifier pour trouver une solution !
Merci bcp pour ton temps!
reda