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

VBA pour copier/coller une rechercheV

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

jeromeN95

XLDnaute Impliqué
Bonjour,
J'aimerai que lorsque je choisi en colonne A, une valeur situer dans une liste déroulante de choix,
Tout le contenue de la ligne (situer dans la feuille "Quoi") y soit recopier.

J'ai mis un exemple SVP.
 

Pièces jointes

Trier par date Trier par votes
Re : VBA pour copier/coller une rechercheV

Bonjour Jérôme,

J'avais commencé par cette macro :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim plage As Range, s As Object
Dim i&, t$
Application.ScreenUpdating = 0: Application.EnableEvents = 0
If Target.Column = 1 And Target.Row > 4 And Target.Count = 1 Then
  t = Target: i = Target.Row
'Suppression des images de la ligne modifiée
   For Each s In ActiveSheet.Shapes
    Set plage = Range(Cells(i, 3), Cells(i, 15))
    On Error Resume Next
     If Not Intersect(s.TopLeftCell, plage) Is Nothing Then
        s.Delete
     End If
     On Error GoTo 0
   Next s
'Copie des images
  If Not IsError(Application.Match(t, Feuil21.Columns(1), 0)) Then
    j = Application.Match(t, Feuil21.Columns(1), 0)
    For c = 3 To 15
     Feuil21.Cells(j, c).Copy Cells(i, c)
    Next
  End If
End If
Application.ScreenUpdating = -1: Application.EnableEvents = -1
End Sub

Mais plusieurs problèmes se posent que je ne comprend pas :
- Lorsque la macro est lancée, on perd la validation des données des colonnes A et B.
- les images sont bien copiées mais leur hauteur est aléatoire, un coup c'est bon, après ça réduit à 2 mm de hauteur ou encore à la moitié de la hauteur normal.

Si quelqu'un peut y regarder, car là ça me gave 😡

A+

Martial
 
Vote positif 0 Vote négatif
Re : VBA pour copier/coller une rechercheV

Bonjour à tous,

Yaloo dans ton code :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim plage As Range, s As Object
Dim i&, t$
Application.ScreenUpdating = 0: Application.EnableEvents = 0
If Target.Column = 1 And Target.Row > 4 And Target.Count = 1 Then
  t = Target: i = Target.Row
'Suppression des images de la ligne modifiée
  For Each s In ActiveSheet.Shapes
    Set plage = Range(Cells(i, 3), Cells(i, 15))
    On Error Resume Next
    If s.Type = msoPicture Then
     If Not Intersect(s.TopLeftCell, plage) Is Nothing Then
        s.Delete
     End If
     End If
     On Error GoTo 0
   Next s
'Copie des images
 If Not IsError(Application.Match(t, Feuil21.Columns(1), 0)) Then
    j = Application.Match(t, Feuil21.Columns(1), 0)
    For c = 3 To 15
     Feuil21.Cells(j, c).Copy Cells(i, c)
    Next
  End If
End If
Application.ScreenUpdating = -1: Application.EnableEvents = -1
End Sub

J'ai ajouté :
Code: 
If s.Type = msoPicture Then

Dis moi ce que tu en pense !

bonne journée
 
Vote positif 0 Vote négatif
Re : VBA pour copier/coller une rechercheV

Salut JBARBE,

Oui c'est bon pour la validation des données, par contre je ne comprend toujours pas pourquoi les images ne se collent pas correctement.

A+
 
Dernière édition:
Vote positif 0 Vote négatif
Re : VBA pour copier/coller une rechercheV

Voici la macro définitive après essai

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim plage As Range, s As Object
Dim i&, t$
Application.ScreenUpdating = 0: Application.EnableEvents = 0
If Target.Column = 1 And Target.Row > 4 And Target.Count = 1 Then
  t = Target: i = Target.Row
'Suppression des images de la ligne modifiée
  For Each s In ActiveSheet.Shapes
    Set plage = Range(Cells(i, 3), Cells(i, 15))
    On Error Resume Next
    If s.Type = msoPicture Then
     If Not Intersect(s.TopLeftCell, plage) Is Nothing Then
        s.Delete
     End If
     End If
     Cells(i, 11).Delete
     On Error GoTo 0
   Next s
'Copie des images
 If Not IsError(Application.Match(t, Feuil21.Columns(1), 0)) Then
    j = Application.Match(t, Feuil21.Columns(1), 0)
    For c = 2 To 15
     Feuil21.Cells(j, c).Copy Cells(i, c)
    Next
  End If
End If
Application.ScreenUpdating = -1: Application.EnableEvents = -1
End Sub

J'ai ajouté >>> Cells(i, 11).Delete

Je t'envoie le fichier qui pour moi ne pose pas de probléme !
 

Pièces jointes

Vote positif 0 Vote négatif
Re : VBA pour copier/coller une rechercheV

Re,

Le Cells(i, 11).Delete supprime toute la colonne 11, je ne vois pas l'intérêt de cette ligne de code.

Avec le fichier que tu as posté ci-dessus, si tu sélectionnes le premier item "Plafond" les images sont-elles avec une dimensions normales ?

Chez moi, ça donne ça


A+
 

Pièces jointes

  • Capture.jpg
    59.3 KB · Affichages: 175
  • Capture.jpg
    59.3 KB · Affichages: 176
Vote positif 0 Vote négatif
Re : VBA pour copier/coller une rechercheV


J'ai mis Cells(i, 11).Delete car le chiffre 15 est une Zone de texte pas une image qui permet d'être supprimée sans agir sur la ligne entiére avec If s.Type = msoPicture Then

D'autre part dans mon fichier si je sélectionne Plafond tout ce passe normalement !

A+
 
Vote positif 0 Vote négatif
Re : VBA pour copier/coller une rechercheV

Re,

Bon, j'ai modifié la macro :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim plage As Range, s As Object
Dim i&, t$
Application.ScreenUpdating = 0: Application.EnableEvents = 0
If Target.Column = 1 And Target.Row > 4 And Target.Count = 1 Then
t = Target: i = Target.Row
'Suppression des images de la ligne modifiée
  Set plage = Range(Cells(i, 3), Cells(i, 15))
  On Error Resume Next
  For Each s In ActiveSheet.Shapes
    If s.Type = 13 Or s.Type = 17 Then
     If Not Intersect(s.TopLeftCell, plage) Is Nothing Then
        s.Delete
     End If
    End If
   Next s
  On Error GoTo 0
'Copie des images
 If Not IsError(Application.Match(t, Feuil21.Columns(1), 0)) Then
    j = Application.Match(t, Feuil21.Columns(1), 0)
    For c = 2 To 15
     Feuil21.Cells(j, c).Copy Cells(i, c)
    Next
  End If
End If
Application.ScreenUpdating = -1: Application.EnableEvents = -1
End Sub

Je trouve que c'est mieux en traitant le type plutôt quand supprimant la cellule, mais chez moi, la dimension des images reste aléatoire.

On va voir ce qu'en pense Jérôme, puisque c'est son post, après tout.

A+

Martial
 
Vote positif 0 Vote négatif
Re : VBA pour copier/coller une rechercheV

Bonsoir et merci beaucoup pour tout ce travail...
Effectivement, c'est génial.
Quel travail !
Merci.

Mais j'ai le même problème, les images sont de dimentions aléatoires, a savoir rétrécies.
N'y a t'il pas la possibilitée de résoudre ce petit désagrément svp?

Bonne soirée.
 
Vote positif 0 Vote négatif
Re : VBA pour copier/coller une rechercheV

Bonjour à tous,

Un essai avec la macro modifiée

Cela donne cela pour moi
 

Pièces jointes

  • image PDN.jpg
    56.9 KB · Affichages: 90
Dernière édition:
Vote positif 0 Vote négatif
Re : VBA pour copier/coller une rechercheV

tres bien, cela marche au poil.
Tu parlais qu'on pouvait mettre le code de la racine ThiwsWorkbooock ?
J'aimerai bien car ça fait long.

Encore bravo et merci de ta réactivité;
 
Vote positif 0 Vote négatif
Re : VBA pour copier/coller une rechercheV

Bonsoir Jérôme, JBARBE,

Voici ton fichier avec une variante, mise à hauteur des images en fonction de la hauteur de la cellule.

Le tout dans le module ThisWorbook, comme ça tu as une seule macro pour toutes tes feuilles (elle ne se déclenche que si le nom de la feuille est numérique).

A+

Martial
 

Pièces jointes

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

C
  • Résolu(e)
XL 2019 Sélection en cascade ou Groupe
Réponses
12
Affichages
342
ciarab8442
C
F
  • Question Question
XL 2016 [VBA] Coller du texte sans formatage
Réponses
8
Affichages
195
F22Raptor
F
J
  • Question Question
Microsoft 365 Excel 365 Problème VBA
Réponses
7
Affichages
263
job75
P
  • Question Question
XL 2021 Macro de découpage suivant une clé
Réponses
14
Affichages
519
job75
  • Question Question
XL 2019 Copier et coller automatiquement une nouvelle donnée par un bouton, ListView décallée à la sur la page (Multipage) et vibration du Userform
2
Réponses
16
Affichages
967
TooFatBoy
G
  • Question Question
XL 2016 filtrer, copier et coller les données avec la macro
Réponses
4
Affichages
320
job75
  • Question Question
XL 2021 Copier coller qui ajoute une référence absolu Toute seule
2
Réponses
24
Affichages
1 K
TooFatBoy
L
  • Question Question
XL 2016 liste
Réponses
10
Affichages
386
chris
M
  • Résolu(e)
XL 2021 Fonction pour rechercher des données, puis à reporter dans une 2ème feuille avec 1 critère
Réponses
13
Affichages
376
job75
N
  • Question Question
Microsoft 365 Sélectionner cellule en fonction d'une liste déroulante
Réponses
9
Affichages
400
Dranreb
L
  • Résolu(e)
XL 2021 Macro - Liste déroulante
Réponses
4
Affichages
179
Piment
P
N
  • Résolu(e)
Microsoft 365 Copier une image d'une feuille de calcul vers un UserForm
Réponses
4
Affichages
192
NONO14
N
A
  • Question Question
Déplacer données en vba
Réponses
3
Affichages
560
akm
A
K
  • Résolu(e)
XL 2010 Roulement automatique
Réponses
9
Affichages
353
komarlehomard
K
L
  • Résolu(e)
Microsoft 365 RechercheV avec une condition poids
2
Réponses
16
Affichages
400
Lina
L
R
  • Question Question
XL 2021 Recherche formule pour compléter une cellule a partir des données d'une autre feuille du classeur (16/03/2026)
2
Réponses
18
Affichages
552
laurent950
  • Résolu(e)
XL 2010 Création de listes déroulantes interactive
6 7 8
Réponses
113
Affichages
4 K
job75
  • Résolu(e)
XL 2019 Problème avec Saisie Intuitive
Réponses
4
Affichages
182
Titof06
W
  • Question Question
Autres Code VBA
Réponses
11
Affichages
469
walki
W
N
  • Résolu(e)
XL 2021 liste déroulante en cascade
Réponses
11
Affichages
636
natadom
N
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…