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 Sub

Bonjour,

Sans regarder "ce que fait" le code, mais simplement sa structure, oui il y a plusieurs problèmes qui sautent aux yeux :

image
  • 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:=xlPasteValues

Et, dans le elseIf

Worksheets("DEVIS").Range("B7").Copy
Worksheets("BPU MAINT").cell(1, dercol).PasteSpecial Paste:=xlPasteValues

C'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 Function

Ca 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 if

Plus 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 ?

image
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 Function
Sub 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 Sub

C'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 Function

Le 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 ?

Exit, instruction (VBA) | Microsoft Learn

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 ?

Oui oui je les ai supprimé !

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 ?

image
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 Sub

Merci :-)

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 With

Bonjour,

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 With

Je 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 :

image

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 Sub

Vous 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.

D'accord, mais maintenant c'est le Vlookup en erreur, sur la ligne en jaune ci-dessous :

image image

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.

Merci pour vos conseils ! Sujet résolu.

Rechercher des sujets similaires à "incrementer donnees feuille criteres"