ComparerLigneEtLancerMacro

[Moa]

Salut à tous !

Voilà j'ai un tableau, avec plein de formules (comme d'hab...héhéhé) et plusieurs macros.

Donc, je ne peux en modifier le positionnement.

Ce tableau fait 25000 lignes.

De la cellule B3 à la cellule N3, j'ai un choix de valeurs (avec une liste de validation).

Mon tableau commence en B10

Pour l'instant ce tableau me servait d'information.

Les lignes ont déjà été triée et sélectionnées selon un ordre, auparavant défini, par une macro.

Mais il doit maintenant, me servir à éliminer des lignes.

Et voici, comment il doit il le faire.

Il doit prendre la première ligne de mon tableau, mais seulement une partie, cad de B10 à N10, la coller de B3 à N3, puis lancer une autre macro.

Puis aller chercher maintenant la deuxième ligne de mon tableau, cad de B11 à N11 et refaire la même opération.

Et ceci jusqu'à la dernière ligne de mon tableau.

J'ai donc fait une macro, mais je n'arrive pas à résoudre deux problèmes :

La boucle pour recommencer l'opération, pour chaque ligne.

Et la fin de la macro arrivé à la dernière ligne de mon tableau, sachant que la longueur de mon tableau est variable.

Si quelqu'un a déjà fait un truc semblable, ce serait vraiment sympa de m'aiguiller.

Merci beaucoup d'avance.

@ +

Moa

 

[Moa]

Salut à tous en ce magnifique samedi matin !

Eh bien, la nuit porte conseil, car après avoir galéré hier soir, j'ai décidé d'aller au lit.

Et ce matin à peine levé (même pas un café dans le ventre), que j'ai trouvé ma macro en quelques minutes....héhéhé...!

Je vous en fait part :

Sub Macro1()
Dim LigneCourante As Range
Dim LigneSuivante As Range

Set LigneCourante = ActiveSheet.Range("B10:N10")
Do While Not IsEmpty(LigneCourante) = True
Set LigneSuivante = LigneCourante.Offset(1, 0)

LigneCourante.Select
Selection.Copy
Range("b3").Select
ActiveSheet.Paste

Call DeleteFaux

Set LigneCourante = LigneSuivante

Loop

End Sub

Et elle marche très bien.

Mais voilà, j'ai un petit hic, elle est très longue.

Donc, j'ai essayé d'enlever les select, en déclarant :

Dim LigneaTester
Set LigneaTester = ActiveSheet.Range = ("B3:N3")

Puis en remplaçant le bloc "LigneCourante.Select....."

Par Set LigneaTester = LigneCourante

Mais là, ça ne marche pas.

La macro tourne mais ne fait rien.

Donc, comme d'hab, si quelqu'un avait une idée, ce serait vraiment très très cool.

Merci et bonne journée à tous

@ +

Moa

 

[michel]

bonjour Moa

j'espere que l'exemple ci joint pourra t'aider .
je n'ai pas fait d'essais pour tester les temps de calcul , pour 25000 lignes à traiter

Sub copy()
Dim lig As Integer
Dim val As Range
For Each val In Range("b10", Range("b10").End(xlDown))
If val.Value <> "" Then
lig = val.Row
Range("b" & lig & ":" & "n" & lig).copy Destination:=Range("b3:n3")

' lancer une autre macro .....

Else
Exit Sub
End If
Next
End Sub


bonne journée
Michel

 

[michel]

bonjour moa

nos messages se sont croisés...;o)

Michel

 

[Moa]

Salut Michel !

Eh oui, tout à fait, nos posts se sont croisés.

Merci pour ta macro, je l'ai testé et elle fonctionne à merveille.

J'y reviendrai, sur cette macro, car associée à la deuxième "DeleteFaux", elles font deux fois le même boulot, à savoir de tester les 25 000 lignes.

@ + et encore merci

Moa