Trouver la première ligne vierge + y insérer valeur

[LeZéro]

Bonjour à tous !

Sans tourner autour du pot : il faut que je puisse, dans une macro, réussir à créer un tableau à partir d'une autre feuille. Ce dernier se compose de plusieures parties, une pour chaque agent. Mais voci les contraintes (qui obligent à passer par la macro d'ailleurs) : la feuille source varie, et je dois faire en sorte que chaque élément du tableau n'empiète pas sur le prochain.

Enfin, peut être comprendrez vous mieux avec mon code :

Sub Macro2()
'
' Macro2 Macro
' Macro enregistrée le 10/09/2008 par L0290266
'

'
Sheets("introduction").Select
Cells.Select
Range("AY157").Activate
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="=1", Operator:=xlOr, _
Criteria2:="=2"
ActiveWindow.ScrollColumn = 41
ActiveWindow.ScrollColumn = 39
ActiveWindow.ScrollColumn = 37
ActiveWindow.ScrollColumn = 34
ActiveWindow.ScrollColumn = 32
ActiveWindow.ScrollColumn = 30
ActiveWindow.ScrollColumn = 29
ActiveWindow.ScrollColumn = 28
ActiveWindow.ScrollColumn = 27
ActiveWindow.ScrollColumn = 26
ActiveWindow.ScrollColumn = 25
ActiveWindow.ScrollColumn = 23
ActiveWindow.ScrollColumn = 20
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 10
Selection.AutoFilter Field:=13, Criteria1:="x"
Range("D71:L1404").Select
Selection.Copy
Sheets("planing").Select
Range("B7").Select

(Je pense que c'est ici qu'on doit ajouter le code correspondant à la recherche de la dernière ligne du tableau.)

ActiveSheet.Paste

End Sub

Cet extrait représente ce qui va faire apparaître un élément du tableau.

 

[LeZéro]

Re : Trouver la première ligne vierge + y insérer valeur

Attention, long code !


Sub créer_planing()

Dim Ligne7 As Long, Ligne8 As Long
Sheets("introduction").Select
Cells.Select
Range("AY157").Activate
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="=1", Operator:=xlOr, _
Criteria2:="=2"
Selection.AutoFilter Field:=13, Criteria1:="x"
Range("D71:L1404").Select
Selection.Copy
Sheets("planing").Select
Ligne1 = Range("B65536").End(xlUp).Offset(1, 0).Row
Range("B" & Ligne1).Select
ActiveSheet.Paste
Ligne2 = Range("B65536").End(xlUp).Row
Range("A" & Ligne1 & ":A" & Ligne2).Value = "Ajilon"
Sheets("introduction").Select
Cells.Select
Range("D5").Activate
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="=1", Operator:=xlOr, _
Criteria2:="=2"
Selection.AutoFilter Field:=13, Criteria1:="x"
Range("AY71:AY1404").Select
Range("AY1404").Activate
Selection.Copy
Sheets("planing").Select
Range("K" & Ligne1).Select
ActiveSheet.Paste

ICI

Sheets("introduction").Select
Cells.Select
Range("AY157").Activate
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="=1", Operator:=xlOr, _
Criteria2:="=2"
Selection.AutoFilter Field:=14, Criteria1:="x"
Range("D71:L1404").Select
Selection.Copy
Sheets("planing").Select
Ligne1 = Range("B65536").End(xlUp).Offset(1, 0).Row
Range("B" & Ligne1).Select
ActiveSheet.Paste
Ligne2 = Range("B65536").End(xlUp).Row
Range("A" & Ligne1 & ":A" & Ligne2).Value = "Aurélie"
Sheets("introduction").Select
Cells.Select
Range("D5").Activate
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="=1", Operator:=xlOr, _
Criteria2:="=2"
Selection.AutoFilter Field:=14, Criteria1:="x"
Range("AY71:AY1404").Select
Range("AY1404").Activate
Selection.Copy
Sheets("planing").Select
Range("K" & Ligne1).Select
ActiveSheet.Paste

End Sub

 

[tototiti2008]

Re : Trouver la première ligne vierge + y insérer valeur

bon, en trichant un peu :

Activesheet.range("B" & Ligne2 +1).value = " "

tu dois refaire l'opération combien de fois (combien de prénom tu as à gérer) ?
parce que, si c'est beaucoup, on peut envisager une boucle.

 

[LeZéro]

Re : Trouver la première ligne vierge + y insérer valeur

Une trentaine de prénoms. Je pense que je peux le faire manuellement. Mais peut être que ça va faire une macro un peu trop lourde (?).

 

[tototiti2008]

Re : Trouver la première ligne vierge + y insérer valeur

Je te propose:

Dim Ligne1 As Long, Ligne2 As Long, Tablo, i as Long
Tablo = Array("Prénom1", "Prénom2", "Prénom3")
For i = lBound(Tablo) to ubound(tablo)
Sheets("introduction").Select
Cells.Select
Range("AY157").Activate
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="=1", Operator:=xlOr, _
Criteria2:="=2"
Selection.AutoFilter Field:=13 + i, Criteria1:="x"
Range("D71:L1404").Select
Selection.Copy
Sheets("planing").Select
Ligne1 = Range("B65536").End(xlUp).Offset(1, 0).Row
Range("B" & Ligne1).Select
ActiveSheet.Paste
Ligne2 = Range("B65536").End(xlUp).Row
Range("A" & Ligne1 & ":A" & Ligne2).Value = Tablo(i)
Sheets("introduction").Select
Cells.Select
Range("D5").Activate
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="=1", Operator:=xlOr, _
Criteria2:="=2"
Selection.AutoFilter Field:=13+i, Criteria1:="x"
Range("AY71:AY1404").Select
Range("AY1404").Activate
Selection.Copy
Sheets("planing").Select
Range("K" & Ligne1).Select
ActiveSheet.Paste
Range("B" & Ligne2+1).value = " "
Next i

 

[LeZéro]

Re : Trouver la première ligne vierge + y insérer valeur

Salut tototiti !

Lorsque je place le code entre 2 éléments (ou prénoms si tu préfères), la macro copie plusieures fois les ligne sur la feuille créée.

En revanche si je tape à chaque fois ton code entre 2 prénoms (donc je dois me cogner les prénoms 2 à 2) ça marche. Mais n'y a t il pas d'autre moyen que ça ?

 

[tototiti2008]

Re : Trouver la première ligne vierge + y insérer valeur

Bonjour LeZéro,

là, j'ai pas compris... peut-être est-il temps de me poster un bout de fichier exemple

 

[LeZéro]

Re : Trouver la première ligne vierge + y insérer valeur

Voilà un échantillon.

Sur la feuille introduction on retoruve donc la ligne des prénoms sur la droite (j'avais pensé à coller ses prénoms autant de fois qu'il y a de lignes par élément mais je ne sais comment le concrétiser en macro), et un bout de la macro (pour la moitié des prénoms par là).

D'ailleurs la macro ne marche plus que pour coller en A sur cet échantillon, mon Collé n'étant pas parfait... enfin c'est pour donner une idée de la gueule du truc

 

[tototiti2008]

Re : Trouver la première ligne vierge + y insérer valeur

je ne comprends pas tout...

à quoi sert

Range("D71:L1404").Select
Selection.Copy

il n'y a rien dedans ?

bon, je te renvoie ton fichier avec le code modifié, dis-moi ce que tu en penses, moi je suis un peu dépassé.

 

[LeZéro]

Re : Trouver la première ligne vierge + y insérer valeur

Voilà un échantillon, après filtrage sur la feuille source ("introduction").

 

[tototiti2008]

Re : Trouver la première ligne vierge + y insérer valeur

et donc (je suis dans le flou), qu'est ce qui marche, qu'est ce qui ne marche pas ?
où sont les prénoms ?
là, je suis perdu

 

[LeZéro]

Re : Trouver la première ligne vierge + y insérer valeur

La macro complète correspondt à cet échantillon, copier collé (ou presque, j'ai changé les prénoms et les colonnes pour que ça corresponde à chaque fois, évidemment) un peu plus de vingt fois. Or ça fait un code trop long ou "Erreur : procédure trop longue". Il me faudrait un moyen de racourcir !

 

[tototiti2008]

Re : Trouver la première ligne vierge + y insérer valeur

et la macro modifiée que je t'ai posté dans mon dernier zip, elle fait quoi ?

 

[LeZéro]

Re : Trouver la première ligne vierge + y insérer valeur

Bien, ma mission touche à sa fin.

J'ai finis mon job. Et c'est en partie grâce à toi Tototiti (mais aussi Pierre Jean !).

Merci, et à bientôt !

 

[tototiti2008]

Re : Trouver la première ligne vierge + y insérer valeur

désolé mais à la fin je ne comprenais plus grand chose... content d'avoir pu t'aider