Autre façon de copier...

[Bruno2019]

Bonjour à tous,

J'ai créé un fichier permettant de rechercher et de sélectionner des lignes de références pour les insérer dans un tableau.

Le débutant que je suis utilise cette méthode (voir ci-dessous) mais j'ai le sentiment qu'il y a plus simple et moins gourmand en ressources. Le but étant, vous l'aurez compris, de copier des cellules non conjointes vers une même ligne (la première ligne dispo).

Sub ajouter()
ActiveSheet.Unprotect "MotDePasse"
If Application.IsNA(Range("N7").Value) Then
MsgBox ("Veuillez sélectionner des caractéristiques valides !")
Exit Sub
End If
If Range("N7") = "Indisponible" Then
MsgBox ("Les caractéristiques sélectionnées ne correspondent à aucun disjoncteur !")
Exit Sub
End If
If Range("D4") <> "" And Range("D7") <> "" And Range("F7") <> "" And Range("H7") <> "" And Range("J7") <> "" And Range("L7") <> "" And Range("N7") <> "Indisponible" Then
Range("D4").Copy
Sheets("Choix").Range("S" & Range("S" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
Range("D7").Copy
Sheets("Choix").Range("T" & Range("S" & Rows.Count).End(xlUp).Row + 0).PasteSpecial Paste:=xlPasteValues
Range("F7").Copy
Sheets("Choix").Range("U" & Range("S" & Rows.Count).End(xlUp).Row + 0).PasteSpecial Paste:=xlPasteValues
Range("H7").Copy
Sheets("Choix").Range("V" & Range("S" & Rows.Count).End(xlUp).Row + 0).PasteSpecial Paste:=xlPasteValues
Range("J7").Copy
Sheets("Choix").Range("W" & Range("S" & Rows.Count).End(xlUp).Row + 0).PasteSpecial Paste:=xlPasteValues
Range("L7").Copy
Sheets("Choix").Range("X" & Range("S" & Rows.Count).End(xlUp).Row + 0).PasteSpecial Paste:=xlPasteValues
Range("N7").Copy
Sheets("Choix").Range("Y" & Range("S" & Rows.Count).End(xlUp).Row + 0).PasteSpecial Paste:=xlPasteValues
Else
MsgBox ("Veuillez sélectionner des caractéristiques valides !")
End If
ActiveSheet.Protect "MotDePasse"
End Sub

Ce code fonctionne mais je suis à l'écoute de toute solution qui serait plus... académique !

Merci.

 

[xUpsilon]

Bonjour,

Une petite boucle pour alléger ce qui peut l'être

If Range("D4") <> "" And Range("D7") <> "" And Range("F7") <> "" And Range("H7") <> "" And Range("J7") <> "" And Range("L7") <> "" And Range("N7") <> "Indisponible" Then
Range("D4").Copy
Sheets("Choix").Range("S" & Range("S" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues
For i = 0 to 5
Cells(7,i*2 + 4).Copy
Sheets("Choix").Cells(Range("S" & Rows.Count.End(xlUp).Row), 20 + i).PasteSpecial Paste:=xlPasteValues
Next i
Else
MsgBox ("Veuillez sélectionner des caractéristiques valides !")
End If

Bonne continuation

 

[kingfadhel]

Bonjour à tous,

Vaut mieux joindre un fichier!

Sub ajouter()
ActiveSheet.Unprotect "MotDePasse"
If Application.IsNA(Range("N7").Value) Then
MsgBox ("Veuillez sélectionner des caractéristiques valides !")
Exit Sub
End If
If Range("N7") = "Indisponible" Then
MsgBox ("Les caractéristiques sélectionnées ne correspondent à aucun disjoncteur !")
Exit Sub
End If
If Range("D4") <> "" And Range("D7") <> "" And Range("F7") <> "" And Range("H7") <> "" And Range("J7") <> "" _
And Range("L7") <> "" And Range("N7") <> "Indisponible" Then
Range("D4").Copy
Sheets("Choix").Range("S" & Range("S" & Rows.Count).End(xlUp).Row + 1).PasteSpecial _
Paste:=xlPasteValues
'// Sélection multiple et collage unique
Range("D7,F7,H7,J7,L7,N7").Copy
Sheets("Choix").Range("T" & Range("S" & Rows.Count).End(xlUp).Row + 0).PasteSpecial _
Paste:=xlPasteValues
Else
MsgBox ("Veuillez sélectionner des caractéristiques valides !")
End If
ActiveSheet.Protect "MotDePasse"
End Sub

 

[Bruno2019]

Merci xUpsilon pour votre réponse mais j'ai désormais une erreur de compilation "qualificateur incorrect" sur .count à la ligne Sheets("Choix").Cells(Range("S") & Rows.Count.End........

 

[xUpsilon]

Re,

J'ai fait une erreur en recopiant en effet, il ne faut pas oublier la parenthèse à la fin de le Range("S") & Rows.Count

 

[Bruno2019]

Bonjour à tous,

Vaut mieux joindre un fichier!

Merci. Ça fonctionne parfaitement.
C'est noté pour le fichier, lors de mes prochaines demandes.

 

[kingfadhel]

Merci. Ça fonctionne parfaitement.
C'est noté pour le fichier, lors de mes prochaines demandes.

Heureux d'avoir aider.
à la prochaine.