Incrémenter des données d'une feuille à une autre selon plusieurs critères
Bonjour,
J'ai commencé à créer le code mais je rencontre quelques difficultés avec les boucles. En gros, je souhaiterais, une fois les données complétées dans la feuille "DEVIS", cliquer sur un bouton afin d'importer les valeurs en jaune, dans les emplacements correspondants dans la feuille "BPU"
La macro devra chercher les valeurs de la colonne A dans BPU (en ignorant les cellules fusionnées) pour récupérer la quantité correspondante à la même référence présente dans la feuille "DEVIS" (en colonne A également). Attention, nous avons deux types de LOT donc il y aura une condition de départ :
Si "LOT 1" ajouter les données à partir de la colonne G de la feuille "BPU" (en décalant les données déjà incrémentées) + indiquer le nom du LOT soit "ZONE A"
Si "LOT 2" ajouter les données à la dernière colonne vide de la feuille BPU + indiquer le nom du LOT soit "ZONE B".
Merci par avance de votre aide.
Belle journée à vous ! :-)
Bonjour,
J'ai tenté d'avancer de mon coté, mais ça coince. Il me dit que le bloc ElseIf sans If... ?? Si vous voyez d'autres anomalies dans mon code, je suis prête à vous lire ! ;-)
Merci à nouveau
Sub EnregistrerDonnées()
'Copier les données dans BPU MAINT en colonne H si secteur LOT1
If Worksheets("DEVIS").Range("C7") = "LOT1" Then
Worksheets("BPU MAINT").Select
Columns("H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H1").Select
'Secteur
Worksheets("DEVIS").Range("B7").Copy
Worksheets("BPU MAINT").Range("H1").PasteSpecial Paste:=xlPasteValues
'Lot
Worksheets("DEVIS").Range("C7").Copy
Worksheets("BPU MAINT").Range("H2").PasteSpecial Paste:=xlPasteValues
'Date d'intervention
Worksheets("DEVIS").Range("D12").Copy
Worksheets("BPU MAINT").Range("H3").PasteSpecial Paste:=xlPasteValues
'Num attachement
Worksheets("DEVIS").Range("F12").Copy
Worksheets("BPU MAINT").Range("H4").PasteSpecial Paste:=xlPasteValues
'num devis
Worksheets("DEVIS").Range("H12").Copy
Worksheets("BPU MAINT").Range("H5").PasteSpecial Paste:=xlPasteValues
'date devis
Worksheets("DEVIS").Range("J12").Copy
Worksheets("BPU MAINT").Range("H6").PasteSpecial Paste:=xlPasteValues
'Commune
Worksheets("DEVIS").Range("B12").Copy
Worksheets("BPU MAINT").Range("H7").PasteSpecial Paste:=xlPasteValues
'Recherche les articles dans le BPU pour ajouter les quantités correspondantes indiquées dans le DEVIS
Dim d As Integer, b As Integer
Dim Devis As Worksheet
Devis = Worksheets("Devis")
Dim BPUMaint As Worksheet
Devis = Worksheets("BPUMaint")
'Boucle pour X lignes au maximum
For d = Devis.Cells(17, 1) To 8
For b = BPUMaint.Cells(11, 1) To 98
'si la cellule recherchée dans devis est trouvé dans BPU Maint copier la valeur de la colonne J dans devis vers la dernière colonne nouvellement ajoutée dans BPU Maint
If Cells(d, 1) = b Then 'Si l'objectif est atteint
Cells(d, 10).Copy
Cells(b, 6).PasteSpecial Paste:=xlPasteValues
Exit For 'On quitte la boucle For
End If
Next
'Copier les données dans BPU MAINT en dernière colonne du tableau si secteur LOT2
ElseIf Worksheets("DEVIS").Range("C7") = "LOT2" Then
Dim dercol As Long
dercol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
'Secteur
Worksheets("DEVIS").Range("B7").Copy
Worksheets("BPU MAINT").cell(1, dercol).PasteSpecial Paste:=xlPasteValues
'Lot
Worksheets("DEVIS").Range("C7").Copy
Worksheets("BPU MAINT").cell(2, dercol).PasteSpecial Paste:=xlPasteValues
'Date d'intervention
Worksheets("DEVIS").Range("D12").Copy
Worksheets("BPU MAINT").cell(3, dercol).PasteSpecial Paste:=xlPasteValues
'Num attachement
Worksheets("DEVIS").Range("F12").Copy
Worksheets("BPU MAINT").cell(4, dercol).PasteSpecial Paste:=xlPasteValues
'num devis
Worksheets("DEVIS").Range("H12").Copy
Worksheets("BPU MAINT").cell(5, dercol).PasteSpecial Paste:=xlPasteValues
'date devis
Worksheets("DEVIS").Range("J12").Copy
Worksheets("BPU MAINT").cell(6, dercol).PasteSpecial Paste:=xlPasteValues
'Commune
Worksheets("DEVIS").Range("B12").Copy
Worksheets("BPU MAINT").cell(7, dercol).PasteSpecial Paste:=xlPasteValues
'Recherche les articles dans le BPU pour ajouter les quantités correspondantes indiquées dans le DEVIS
'Boucle
For d = Devis.Cells(17, 1) To 8
For b = BPUMaint.Cells(11, 1) To 98
'si la cellule recherchée dans devis est trouvé dans BPU Maint copier la valeur de la colonne J dans devis vers la dernière colonne nouvellement ajoutée dans BPU Maint
If Cells(d, 1) = b Then 'Si l'objectif est atteint
Cells(d, dercol).Copy
Cells(b, dercol).PasteSpecial Paste:=xlPasteValues
Exit For 'On quitte la boucle For
End If
Next
End If
End SubBonjour,
Sans regarder "ce que fait" le code, mais simplement sa structure, oui il y a plusieurs problèmes qui sautent aux yeux :
- a) ici le programme plante car il cherche à appliquer le ElseIf correspondant à un bloc "IF" situé DANS VOS BOUCLES FOR, or ce n'est pas le cas, le ElseIf correspond au bloc IF de votre 1e ligne du Sub, situé EN DEHORS des boucles for.
La correction à effectuer est d'ajouter un next là où arrive ma flèche. De meme dans le bloc similaire en fin de votre code.
Deux conseils :
- Utilisez un indentateur de code, Rubberduck est une option que j'affectionne, mais je sais qu'ici d'autres alternatives "plus légères" sont utilisées, qui vous correspondent peut etre davantage. Il existe également des indentateurs VBA en ligne.
- N'écrivez PAS vos Next sans instruction, écrivez "Next d", "Next b". SURTOUT quand vous avez des boucles imbriquées. Vous comprendrez beaucoup mieux "où vous en etes". En plus c'est plus clair.
Bonjour,
Merci beaucoup pour vos précieux conseils saboh12617 ! :-) Je débute et j'avoue j'essais plusieurs codes pour tenter de comprendre la logique. Je vois que ma méthode n'est pas forcément efficace ;-)
Je vais regarder cela. Encore merci
Bonne journée !
Enfin, de manière générale votre code est très long pour faire quelque chose de simple. S'il marche et vous convient pas de soucis, gardez le ainsi !
Mais si vous voulez l'améliorer essayez de prendre du recul, et voir quels groupes d'instructions vous avez, entre guillements, "copié/collé" puis adapté au besoin. Si vous effectuez la meme chose mais avec 2 entrées différentes vous pouvez très souvent ne l'écrire qu'une fois.
Un petit exemple pour comprendre :
Vous avez plein de
Worksheets("DEVIS").Range("B7").Copy
Worksheets("BPU MAINT").Range("H1").PasteSpecial Paste:=xlPasteValuesEt, dans le elseIf
Worksheets("DEVIS").Range("B7").Copy
Worksheets("BPU MAINT").cell(1, dercol).PasteSpecial Paste:=xlPasteValuesC'est la meme chose ! Seules les destinations changent.
Vous pourriez faire une fonction du type
Function CopierVers(destinationCol)
Dim cellulesACopier(1 To 7) ' Array (liste) de vos cellules (B7, C7, D12…)
' ici vous remplissez la liste
Dim i as Long
For i = 1 to 7
celluleACopier(i).Copy
Worksheets("BPU MAINT").Cells(i, destinationCol).PasteSpecial Paste:=xlPasteValues
Next i
End FunctionCa vous permet de remplacez les 2 énormes blocs par
If Worksheets("DEVIS").Range("C7") = "LOT1" Then
CopierVers(8) ' 8 = colonne H
' … reste du code
ElseIf Worksheets("DEVIS").Range("C7") = "LOT2" Then
Dim dercol As Long
dercol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
CopierVers(dercol)
' …
End ifPlus facile à gérer selon moi, et surtout à relire et corriger.
Je n'arrive pas à trouver mon erreur. Le code indique en surlignant en jaune "cellulesACopier =" :
Pouvez-vous m'aider svp ?
Function CopierVers(destinationCol)
Dim cellulesACopier(1 To 7) ' Array (liste) de vos cellules (B7, C7, D12…)
cellulesACopier = Array(Worksheets("DEVIS").Range("B7,C7,D12,F12,H12,J12,B12"))
Dim i As Long
For i = 1 To 7
celluleACopier(i).Copy
Worksheets("BPU MAINT").Cells(i, destinationCol).PasteSpecial Paste:=xlPasteValues
Exit For
Next i
End FunctionSub EnregistrerDonnees()
Dim d As Integer
Dim b As Integer
Dim Devis As Worksheet
Dim BPUMaint As Worksheet
Set Devis = Worksheets("DEVIS")
Set BPUMaint = Worksheets("BPU_MAINT")
'Copier les données dans BPU MAINT en colonne H si secteur LOT1
If Worksheets("DEVIS").Range("C7") = "LOT1" Then
Worksheets("BPU MAINT").Columns("H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H1").Select
CopierVers (8)
'Boucle pour rechercher les valeurs dans BPU et importer la quantité depuis la feuille DEVIS
For d = 17 To 8
For b = 11 To 98
If Cells(d, 1) = d Then
Devis.Cells(d, 10).Copy
BPUMaint.Cells(b, 8).PasteSpecial Paste:=xlPasteValues
End If
Exit For
Exit For
Next b
Next d
'Copier les données dans BPU MAINT en dernière colonne du tableau si secteur LOT2
Else
Dim dercol As Long
dercol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
CopierVers (dercol)
'Boucle pour rechercher les valeurs dans BPU et importer la quantité depuis la feuille DEVIS
For d = 17 To 8
For b = 11 To 98
If Cells(d, 1) = b Then
Devis.Cells(d, dercol).Copy
BPUMaint.Cells(b, dercol).PasteSpecial Paste:=xlPasteValues
End If
Exit For
Exit For
Next b
Next d
End If
End SubC'est quasi bon, voici votre code corrigé :
Function CopierVers(destinationCol As Long)
Dim xlRng as Range
Set xlRng = Worksheets("DEVIS").Range("B7,C7,D12,F12,H12,J12,B12")
Dim cellulesACopier(1 To 7) As Range, i As Long
For i = 1 To xlRng.Count
Set cellulesACopier(i) = xlRng.Item(i)
Next i
For i = 1 To 7
celluleACopier(i).Copy
Worksheets("BPU MAINT").Cells(i, destinationCol).PasteSpecial Paste:=xlPasteValues
Next i
End FunctionLe problème est que vous ne pouvez pas créer la liste d'un coup avec Array, vous devez itérer pour sélectionner une par une les cellules.
Par contre un point important, ne mettez pas de Exit For ‼ Autrement vous sortez de la boucle au premier passage… Avez vous bien compris comment fonctionne cette instruction ?
Oui maintenant je comprends mieux l'utilité du Exit For ! Merci. :-)
La bonne nouvelle, je n'ai plus d'erreur ! La mauvaise, je n'ai pas les bonnes valeurs incrémentées pour les cellules indiquées dans la fonction "CopierVers" : "B7,C7,D12,F12,H12,J12,B12". Il me mets trois valeurs sans aucun rapport avec celles souhaitées.
Et, les quantités du devis ne se copient pas non plus, donc les boucles ne fonctionneraient pas. Et, je crois savoir pourquoi : en faite, je souhaiterais que la macro recherche chaque référence indiqués dans le DEVIS dans la feuille BPU pour indiquer en face la valeur correspondante à celle du devis MAIS la macro doit comparer ligne par ligne sans chercher de façon aléatoire. Je me dis qu'il me faudrait un code similaire à la recherche V. Avez-vous une suggestion à me proposer, svp ?
Je vais continuer mes recherches de mon coté ! ;-)
Avez-vous pensé à corriger les Exit For de vos autres boucles ?
Bonjour,
N'arrivant pas à comprendre l'erreur sur la fonction CopierVers, j'ai préféré la supprimer et reprendre mon code qui fonctionnait. Ainsi, j'ai réussi à avancer sur mon code mais je suis bloquée sur la boucle de Vlookup :
Je souhaiterais faire une boucle avec cette fonction. Pourriez vous m'aider à trouver mon erreur, svp ?
Sub EnregistrerDonnees()
Dim b As Integer
Dim Devis As Worksheet
Dim BPUMaint As Worksheet
Set Devis = Worksheets("DEVIS")
Set BPUMaint = Worksheets("BPU_MAINT")
Dim Recherche As Variant
'Copier les données dans BPU MAINT en colonne H si secteur LOT1
If Worksheets("DEVIS").Range("C7") = "LOT1" Then
Worksheets("BPU_MAINT").Select
Columns("H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'Secteur
Worksheets("DEVIS").Range("B7").Copy
Worksheets("BPU_MAINT").Range("H1").PasteSpecial Paste:=xlPasteValues
'Lot
Worksheets("DEVIS").Range("C7").Copy
Worksheets("BPU_MAINT").Range("H2").PasteSpecial Paste:=xlPasteValues
'Date d'intervention
Worksheets("DEVIS").Range("D12").Copy
Worksheets("BPU_MAINT").Range("H3").PasteSpecial Paste:=xlPasteValues
'Num attachement
Worksheets("DEVIS").Range("F12").Copy
Worksheets("BPU_MAINT").Range("H4").PasteSpecial Paste:=xlPasteValues
'num devis
Worksheets("DEVIS").Range("H12").Copy
Worksheets("BPU_MAINT").Range("H5").PasteSpecial Paste:=xlPasteValues
'date devis
Worksheets("DEVIS").Range("J12").Copy
Worksheets("BPU_MAINT").Range("H6").PasteSpecial Paste:=xlPasteValues
'Commune
Worksheets("DEVIS").Range("B12").Copy
Worksheets("BPU_MAINT").Range("H7").PasteSpecial Paste:=xlPasteValues
'Boucle pour rechercher les valeurs dans BPU et importer la quantité depuis la feuille DEVIS
Dim ligfin As Integer
ligfin = Cells(Cells.Rows.Count, "A").End(xlUp).Row
With BPUMaint
For b = 11 To ligfin
.Range("H" & b).Value = WorksheetFunction.VLookup(.Range("A" & b).Value, Devis.Range("A17:j24"), 10, False)
Next b
End With
'Copier les données dans BPU MAINT en dernière colonne du tableau si secteur LOT2
Else
Dim dercol As Long
dercol = BPUMaint.Cells(1, Cells.Columns.Count).End(xlToLeft).Column + 1
'Secteur
Worksheets("DEVIS").Range("B7").Copy
Worksheets("BPU_MAINT").cell(1, dercol).PasteSpecial Paste:=xlPasteValues
'Lot
Worksheets("DEVIS").Range("C7").Copy
Worksheets("BPU_MAINT").cell(2, dercol).PasteSpecial Paste:=xlPasteValues
'Date d'intervention
Worksheets("DEVIS").Range("D12").Copy
Worksheets("BPU_MAINT").cell(3, dercol).PasteSpecial Paste:=xlPasteValues
'Num attachement
Worksheets("DEVIS").Range("F12").Copy
Worksheets("BPU_MAINT").cell(4, dercol).PasteSpecial Paste:=xlPasteValues
'num devis
Worksheets("DEVIS").Range("H12").Copy
Worksheets("BPU_MAINT").cell(5, dercol).PasteSpecial Paste:=xlPasteValues
'date devis
Worksheets("DEVIS").Range("J12").Copy
Worksheets("BPU_MAINT").cell(6, dercol).PasteSpecial Paste:=xlPasteValues
'Commune
Worksheets("DEVIS").Range("B12").Copy
Worksheets("BPU_MAINT").cell(7, dercol).PasteSpecial Paste:=xlPasteValues
'Boucle pour rechercher les valeurs dans BPU et importer la quantité depuis la feuille DEVIS
With BPUMaint
For b = 11 To ligfin
.Range(dercol & b).Value = WorksheetFunction.VLookup(.Range("A" & b).Value, Devis.Range("A17:j24"), 10, False)
Next b
End With
End If
End SubMerci :-)
Bonjour,
Le code VlookUp fonctionne. Je recherche à présent la possibilité de supprimer les NA ! Il me dit : "erreur de compilation, Else sans If"
Pouvez vous m'aider svp ?
'Boucle pour rechercher les valeurs dans BPU et importer la quantité depuis la feuille DEVIS
Dim ligfin As Integer, V As Variant, RechercheV As Integer
ligfin = Cells(Cells.Rows.Count, "A").End(xlUp).Row
RechercheV = BPUMaint.Range("H" & b).Value = Application.VLookup(BPUMaint.Range("A" & b).Value, Devis.Range("A17:J24"), 10, False)
With BPUMaint
For b = 9 To ligfin
If IsError(RechercheV) = "#N/A" Then BPUMaint.Range("H" & b).Value = ""
Else: RechercheV
End If
Next b
End WithBonjour,
Essayez ceci :
With BPUMaint
For b = 9 To ligfin
If IsError(RechercheV) = "#N/A" Then
BPUMaint.Range("H" & b).Value = ""
Else
RechercheV
End If
Next b
End WithJe pense que vous n'aviez pas mis ":" après Then, c'est nécessaire, comme pour Else. Préférez sauter une ligne.
Bonjour,
Ca ne fonctionne pas, il me dit :
Je vous met mon code entier :
Sub EnregistrerDonnees()
Dim b As Integer
Dim Devis As Worksheet
Dim BPUMaint As Worksheet
Set Devis = Worksheets("DEVIS")
Set BPUMaint = Worksheets("BPU_MAINT")
'Copier les données dans BPU MAINT en colonne H si secteur LOT1
If Worksheets("DEVIS").Range("C7") = "LOT1" Then
Worksheets("BPU_MAINT").Select
Columns("H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
'Lot
Worksheets("DEVIS").Range("C7").Copy
Worksheets("BPU_MAINT").Range("H2").PasteSpecial Paste:=xlPasteValues
'Date d'intervention
Worksheets("DEVIS").Range("D12").Copy
Worksheets("BPU_MAINT").Range("H3").PasteSpecial Paste:=xlPasteValues
'Num attachement
Worksheets("DEVIS").Range("F12").Copy
Worksheets("BPU_MAINT").Range("H4").PasteSpecial Paste:=xlPasteValues
'num devis
Worksheets("DEVIS").Range("H12").Copy
Worksheets("BPU_MAINT").Range("H5").PasteSpecial Paste:=xlPasteValues
'date devis
Worksheets("DEVIS").Range("J12").Copy
Worksheets("BPU_MAINT").Range("H6").PasteSpecial Paste:=xlPasteValues
'Commune
Worksheets("DEVIS").Range("B12").Copy
Worksheets("BPU_MAINT").Range("H7").PasteSpecial Paste:=xlPasteValues
'Boucle pour rechercher les valeurs dans BPU et importer la quantité depuis la feuille DEVIS
Dim ligfin As Integer, RechercheV As Integer
On Error Resume Next
ligfin = Cells(Cells.Rows.Count, "A").End(xlUp).Row
RechercheV = BPUMaint.Range("H" & b).Value = Application.VLookup(BPUMaint.Range("A" & b).Value, Devis.Range("A17:J24"), 10, False)
With BPUMaint
For b = 9 To ligfin
If IsError(RechercheV) = "#N/A" Then
BPUMaint.Range("H" & b).Value = ""
Else
RechercheV
End If
Next b
End With
'Copier les données dans BPU MAINT en dernière colonne du tableau si secteur TONNERROIS
Else
Dim dercol As Long
dercol = BPUMaint.Cells(1, Cells.Columns.Count).End(xlToLeft).Column + 1
'Secteur
Worksheets("DEVIS").Range("B7").Copy
Worksheets("BPU_MAINT").cell(1, dercol).PasteSpecial Paste:=xlPasteValues
'Lot
Worksheets("DEVIS").Range("C7").Copy
Worksheets("BPU_MAINT").cell(2, dercol).PasteSpecial Paste:=xlPasteValues
'Date d'intervention
Worksheets("DEVIS").Range("D12").Copy
Worksheets("BPU_MAINT").cell(3, dercol).PasteSpecial Paste:=xlPasteValues
'Num attachement
Worksheets("DEVIS").Range("F12").Copy
Worksheets("BPU_MAINT").cell(4, dercol).PasteSpecial Paste:=xlPasteValues
'num devis
Worksheets("DEVIS").Range("H12").Copy
Worksheets("BPU_MAINT").cell(5, dercol).PasteSpecial Paste:=xlPasteValues
'date devis
Worksheets("DEVIS").Range("J12").Copy
Worksheets("BPU_MAINT").cell(6, dercol).PasteSpecial Paste:=xlPasteValues
'Commune
Worksheets("DEVIS").Range("B12").Copy
Worksheets("BPU_MAINT").cell(7, dercol).PasteSpecial Paste:=xlPasteValues
' 'Boucle pour rechercher les valeurs dans BPU et importer la quantité depuis la feuille DEVIS
With BPUMaint
For b = 9 To ligfin
If IsError(RechercheV) = "#N/A" Then
BPUMaint.Range(dercol & b).Value = ""
Else
RechercheV
End If
Next b
End With
End If
End SubVous ne pouvez pas écrire "Else RechercheV". Ca ne veut rien dire puisque RechercheV est un integer. VBA cherche une opération à effectuer hors il n'y en a pas. Si vous ne souhaitez rien faire, ne mettez pas de Else.
Ne mettez pas 2 "=" à la suite.
Là votre problème est basique : vous avez défini RechercheV comme un entier, et vous voulez lui affecter un Boolean, puisque en mettant "A=B=C" cela veut dire A = (B=C), càd A prend la valeur "B est égal à C ?" → oui ou non.
Pour faire ce que vous voulez faire, en supposant que vous voulez affecter A et B sur C, on prend 2 lignes et on écrit :
A=C
B=C
Vraiment, pour votre propre bien, évitez ces codes biscornus que vous semblez apprécier en mettant plusieurs affectations sur une meme ligne, c'est dur à relire et surtout vous faites face à plein de problèmes qui ne devraient pas avoir lieu d'etre puisque en faisant ainsi vous arrivez face à votre limite de compréhension du code et bloquez inutilement.
1 instruction/affectation par ligne. C'est tout, c'est clair, et ca ne bugue pas. Ou si ca bugue on comprend tout de suite pourquoi.

