Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Autre façon de copier...

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
B

Bruno2019

Guest
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).

VB: 
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.
 
Solution
Bonjour à tous,

Vaut mieux joindre un fichier!

Code: 
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...
Trier par date Trier par votes
Bonjour,

Une petite boucle pour alléger ce qui peut l'être
VB: 
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
 
Vote positif 0 Vote négatif
Bonjour à tous,

Vaut mieux joindre un fichier!

Code: 
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
 
Vote positif 0 Vote négatif
Solution
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........
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Résolu(e)
XL 2019 Modifier ce code pour de sorte à y rajouter un commentaire après clic droit en colonne I (9) à préremplir mais vierge ?
Réponses
8
Affichages
262
anthoYS
  • Question Question
XL 2016 trier 4 colonnes d'une plage de cellules
Réponses
8
Affichages
213
KTM
C
  • Question Question
XL 2021 Exporter des données vers une autre feuille...
Réponses
7
Affichages
139
sylvanu
  • Question Question
XL 2019 Prénoms à souhaiter
2
Réponses
15
Affichages
722
lynyrd
U
  • Question Question
Autres [RÉSOLU] macro à modifier
Réponses
1
Affichages
607
un internaute
U
  • Résolu(e)
XL 2019 macro avec fonction copié coller si rempli par la macro
Réponses
12
Affichages
630
AtTheOne
T
  • Résolu(e)
Microsoft 365 VBA Exporter une sélection de plages nommées au format PDF
Réponses
12
Affichages
1 K
tnion
T
  • Question Question
Microsoft 365 Excel VBA: manipuler des fichiers partagés via Teams / Sharepoint
Réponses
0
Affichages
14
Eric 888
C
  • Résolu(e)
XL 2021 Mise en forme MsgBox
2 3
Réponses
43
Affichages
873
Constantin
C
Z
  • Résolu(e)
Microsoft 365 Problème de combinaison entre fonctions "If Then Else" et "SelectCase"
Réponses
11
Affichages
909
Zonmé
Z
S
  • Résolu(e)
XL 2016 Coller nom classeur sur plage cellules
Réponses
9
Affichages
629
safranien
S
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
987
Phil69970
N
  • Question Question
XL 2013 Utilisé deux CommandButton_Click dans la même feuil
Réponses
4
Affichages
421
patricktoulon
  • Question Question
Microsoft 365 VBA : copier les adresses
Réponses
7
Affichages
1 K
VBA_dev_Anne_Marie
  • Question Question
Autres fenêtre "Publication"
Réponses
10
Affichages
782
ph.vanne
P
  • Question Question
XL 2016 Compteur avec incrémentation de la ligne suivante
Réponses
11
Affichages
492
Pascal THIDET
P
A
  • Question Question
XL 2010 Filtrer un Combobox en VBA excel
2 3
Réponses
43
Affichages
3 K
Dranreb
T
  • Question Question
XL 2013 Impression, choix de feuilles et nombre de copie
Réponses
11
Affichages
772
AtTheOne
F
  • Question Question
XL 2021 probleme dans la macro
Réponses
4
Affichages
714
kiki29
S
  • Résolu(e)
Microsoft 365 Mailing mise en forme HTML : revenir à la ligne automatique si trop de texte saisie
2
Réponses
17
Affichages
1 K
spike29
S
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…