Copie de cellule dans une autre feuille à une position précise. (Erreur)
Bonjour,
Je suis actuellement sur un projet de VBA dont je vais vous expliquer le details ci dessous.
Dans un premier temps je suis en possession d'une sheet a 3 colonnes (Feuilles 21) ainsi que d'un tableau situé sur la feuille 13. Je souhaite créer une macro VBA qui me prend les differentes valeur d'une colonnes et me copies la ligne associé à la valeurs au bon endroit de la feuille 13.
On detectera la bonne position ou coller la ligne en fonction de la valeur de la colonne B sur cette ligne. Si par exemple la ligne 3 à comme valeur a la colonne B un "visage" il faudra copier les 10 lignes suivantes en dessous de la cellule ayant écris "visage" sur la feuille 13 où la premiere colonne sera collé à la colonne de la cellule trouvé, la colonne B à la droite de celle ci etc.
J'ai réalisé le code suivant
Sub CopierValeursEnDessous(celluleDepart As Range, plageValeurs As Range, colonneDepart As Integer)
Dim ws As Worksheet
Set ws = celluleDepart.Worksheet
' Copier les valeurs dans les 10 lignes en dessous de la cellule de départ
ws.Cells(celluleDepart.Row + 1, colonneDepart).Resize(10, plageValeurs.Columns.Count).value = plageValeurs.value
End Sub
Function TrouverCellule(caractere As String, feuille As Worksheet) As Range
Dim cel As Range
Dim plage As Range
Set TrouverCellule = Nothing ' Initialiser à Nothing au cas où la sous-chaîne n'est pas trouvée
' Spécifier la plage de recherche comme étant toute la feuille (remarquez le point entre feuille et Cells)
Set plage = feuille.Cells
' Utiliser la méthode Find pour rechercher la sous-chaîne dans toute la feuille
Set cel = plage.Find(What:=caractere, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If Not cel Is Nothing Then
Set TrouverCellule = cel
End If
End Function
Sub CopierValeursParEtiquette()
Dim wsData As Worksheet ' Feuille de données avec la liste de données étendue sur 3 colonnes
Dim wsOutput As Worksheet ' Feuille de sortie où nous stockerons les lignes correspondantes
Dim lastRowData As Long, lastRowOutput As Long
Dim dataRange As Range
Dim outputRange As Range
Dim rowIndex As Long
Dim colIndex As Integer
Dim label As String
Dim dictLabels As Object ' Dictionnaire pour stocker les étiquettes et leurs positions dans la feuille de sortie
Dim labelCell As Range ' Cellule contenant l'étiquette trouvée
Dim plageValeurs As Range ' Plage de valeurs à copier
Dim labelKey As Variant ' Variable de contrôle pour parcourir les éléments du dictionnaire
' Remplacez "Feuil1" par le nom de la feuille contenant la liste de données étendue sur 3 colonnes
Set wsData = ThisWorkbook.Worksheets("Feuil21")
' Remplacez "Feuil2" par le nom de la feuille de sortie
Set wsOutput = ThisWorkbook.Worksheets("Feuil13")
' Remplacez "A:C" par la plage de colonnes de la liste de données étendue
' Assurez-vous que cette plage comprend les en-têtes de colonne
Set dataRange = wsData.Range("A:C")
' Trouver la dernière ligne de données dans la plage de colonnes
lastRowData = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
' Initialiser un dictionnaire pour stocker les étiquettes et leurs positions dans la feuille de sortie
Set dictLabels = CreateObject("Scripting.Dictionary")
' Parcourir la liste de données étendue pour repérer les étiquettes et leurs positions dans la feuille de sortie
For rowIndex = 2 To lastRowData ' Commencer à partir de la 2e ligne pour éviter le titre (en-tête) de colonne
label = wsData.Cells(rowIndex, "B").value ' Prendre l'étiquette dans la colonne B
' Chercher l'étiquette dans la deuxième feuille
Set labelCell = TrouverCellule(label, wsData)
If Not labelCell Is Nothing Then ' Si l'étiquette est trouvée dans la deuxième feuille
If Not dictLabels.Exists(label) Then
dictLabels.Add label, labelCell.Row ' Ajouter l'étiquette et sa position dans le dictionnaire
End If
End If
Next rowIndex
' Parcourir le dictionnaire pour copier les valeurs sous chaque étiquette trouvée
For Each labelKey In dictLabels.Keys
Dim currentLabel As String
currentLabel = labelKey ' Créer une nouvelle variable pour stocker la valeur de l'étiquette
' Trouver la position de l'étiquette dans la feuille de données
Set labelCell = TrouverCellule(currentLabel, wsOutput)
' Copier les valeurs correspondantes dans les 10 lignes en dessous de l'étiquette trouvée dans la feuille de données
Set plageValeurs = wsData.Cells(dictLabels(currentLabel).Row + 1, dictLabels(currentLabel).Column).Resize(10, 3) ' Plage de valeurs à copier (10 lignes x 3 colonnes)
' Appel de la fonction pour copier les valeurs dans la feuille de sortie (à partir de la ligne actuelle)
CopierValeursEnDessous TrouverCellule(currentLabel, wsOutput), plageValeurs, TrouverCellule(currentLabel, wsOutput).Column
Next labelKey
End SubJ'obtiens une erreur à "set plagevaleurs [...]resize(10,3)". (Objet requis erreur 424)
Pourriez vous m'aider à résoudre ce problème et à obtenir un code qui fonctionne?
Bien cordialement,
PS : Je reste à votre disposition pour toutes questions relative à ce sujet.
Bonjour,
Merci d'utiliser les balises de code lorsque vous postez un code. Click sur l'icone </> puis coller le code dans la fenêtre. J'ai corrigé pour vous montrer.
A quoi correspond :
set ws = celluleDepart.WorksheetC'est le nom de votre feuille cela ?
Cordialement
Oui , cela me donnait la feuille dans laquelle était ma cellule de départ.
Oui , cela me donnait la feuille dans laquelle était ma cellule de départ.
Ok mais cela ne permet pas de déclarer un objet worksheet
Essayez plutôt comme ceci
Set Ws = Worksheets(Range(ThisWorkbook.Names("celluledepart")).Value)Avec "celluledepart" contenant le nom de la feuille concernée
Si ok pensez à
Cordialement
J'ai toujours la meme erreur à savoir un "objet requis" sur la ligne set plageValeurs = wsData.cells etc malheureusement :/
J'ai toujours la meme erreur à savoir un "objet requis" sur la ligne set plageValeurs = wsData.cells etc malheureusement :/
A cette ligne, vous êtes sûr que wsdata est bien la feuille dont l'onglet est nommé "Feuil21" ?
Oui sur et certains.
Normal que vous définissez plagevaleurs dans la boucle ?
For Each labelKey In dictLabels.KeysAvez-vous testé en faisant du pas à pas dans le code ?
Bah vu que ma plage valeur doit etre les 10 ligne en dessous de chaque étiquette c'est normal que je la définisse dans la boucle vu que je ne veux pas avoir à copier toujours la meme plage de valeurs.
Pour ce qui est de faire du Pas à Pas je ne vois pas ce que vous voulez dire, pourriez vous préciser?
Pour ce qui est de faire du Pas à Pas je ne vois pas ce que vous voulez dire, pourriez vous préciser?
C'est le mode débogage
- cliquez sur la ligne Sub CopierValeursParEtiquette()
- Appuyez sur F9 ou FN +F9 sur votre clavier. Cela met la ligne en couleur Brune
- Exécutez le code depuis un bouton (je suppose). Le code va s'arrêter sur Sub copier.... et le souligner en jaune
- Appuyez ensuite sur F8 (ou FN + F8) pour avancer pas à pas dans le code
Il se peut que ce ne soit pas au premier "For each labelkey..." que vous avez une erreur mais plus tard dans le processus d'excution de la boucle
Bonjour le fil,
Dan ne vous l'a pas demandé par politesse, mais merci de joindre un fichier à votre demande SVP
Dans l'état actuel des choses, il sera impossible de vous aider correctement
Cordialement.
bonjour BrunoM45,Dan, Kyriux,
c'est "wsdata" ou "wsoutput" ?
' Chercher l'étiquette dans la deuxième feuille
Set labelCell = TrouverCellule(label, wsData)