Archivage en colonne - double critères

Le 03/01/2022 à 11:11

Bonjour à tous,

Je viens vous solliciter aujourd'hui pour une problématique d'archivage en colonne (en ligne ça marche, mais en colonne je n'y parviens pas).

Le fichier se compose de plusieurs onglets, or ceux qui nous intéresse se nomme "Nouveau Devis" & "Base Devis".

Le besoin :

Lors de la création d'un nouveau devis, je renseigne l'onglet correspondant.

A la fin de celui-ci, je souhaite qu'une macro

-> Incrémente à +1 la référence pour le prochain devis (Ok, voir code "Ajouter")

-> Efface les données après enregistrements pour le prochain devis(Ok, voir code "Effacer")

-> Enregistre dans la colonne correspondante à la valeur en H4 de l'onglet "Nouveau devis", dans l'onglet "Base devis", les différentes cellules correspondantes à l'adressage suivant (exemple pour devis N°0001) :

image

- F13 ("Nouveau devis") = B2 ("Base devis")

- D:E16 = B8

- H:I16 = B4

- H5 = B3

- D39:D40 = B7

- H42 = B5

- H43 = B6

- H39 = B9

Et enfin, pour chaque code en P0XXX, identifier la ligne correspondante dans l'onglet "Base devis" et y inscrire la quantité (ex : Si code P0001 qty 3 sur onglet "Nouveau devis", inscrire dans l'onglet "Base devis" en colonne B10 la valeur 3).

image

Mon code pour les deux premières fonctions ainsi que l'appelle de la fonction "Enregistrer" qu'il faut donc compléter :

image

Je ne peux vous partager le fichier source car celui-ci contient toutes mes données personnelles et ceux de mes clients.

J'espère que les photos vous permettront de visualiser mon besoin... :)

Je vous remercie de votre aide et Bonne année à tous !! :)

Le 03/01/2022 à 18:46

Bonjour

Je ne peux vous partager le fichier source car celui-ci contient toutes mes données personnelles et ceux de mes clients.

Pour éviter de tout refaire, vous pouvez mettre une fichier anonimysé --> https://forum.excel-pratique.com/forum/anonymiser-les-donnees-confidentielles-des-fichiers-excel-107...

Cordialement

Le 04/01/2022 à 08:42

Super, Dan ! Merci :)

Je vous partage donc mon fichier test vous permettant de mieux comprendre mon besoin (je pense).

23test.xlsm (233.75 Ko)
Le 04/01/2022 à 10:16

Bonjour

Votre code à tester

Sub Enregistrer()
Dim col As Integer, lig As Integer
Dim i As Byte

With Sheets("Base Devis")
    On Error Resume Next
    col = .Rows("1:1").Find(Format(Sheets("Nouveau Devis").Range("H4").Value, "00000"), LookIn:=xlValues, lookat:=xlWhole).Column
    If col = 0 Then col = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
    On Error GoTo 0

    .Cells(1, col).Value = Sheets("Nouveau Devis").Range("H4").Value 'num
    .Cells(2, col) = Sheets("Nouveau Devis").Range("F13").Value 'client
    .Cells(3, col) = Sheets("Nouveau Devis").Range("H5").Value 'Date devis
    .Cells(4, col) = Sheets("Nouveau Devis").Range("H16").Value 'Date valid
    .Cells(5, col) = Sheets("Nouveau Devis").Range("H42").Value 'Acompte
    .Cells(6, col) = Sheets("Nouveau Devis").Range("H43").Value 'Mi chantier
    .Cells(7, col) = Sheets("Nouveau Devis").Range("D39").Value 'Mi chantier
    .Cells(8, col) = Sheets("Nouveau Devis").Range("D16").Value 'Adresse travaux
    .Cells(9, col) = Sheets("Nouveau Devis").Range("H39").Value 'total HT

    For i = 1 To 18
        If Sheets("Nouveau Devis").Range("C" & i + 18).Value = "" Then Exit Sub
        On Error Resume Next
        lig = .Range("A:A").Find(Sheets("Nouveau Devis").Cells(i + 18, 3).Value, LookIn:=xlValues, lookat:=xlWhole).Row
        If lig = 0 Then MsgBox "le code article n'existe pas en feuille Base devis"
        .Cells(lig, col) = Sheets("Nouveau Devis").Range("F" & i + 18).Value
    Next i
End With
End Sub

Quelques remarques au sujet de vos autres codes

- Si vous utilisez l'instruction Application.ScreenUpdating = False, pensez à remettre la valeur FALSE à TRUE à la fin de votre code
- dans la sub ajouter, l'instruction Application.ScreenUpdating doit être à FALSE au début du code et non à TRUE
- Dans cette partie de code :

With ThisWorkbook
    With Sheets("Nouveau Devis")

Il manque le point devant --> Sheets("nouveau devis"). Toutefois faites plutot ceci

With ThisWorkbook.Sheets("Nouveau Devis")

Puis enlevez 1 END WITH de trop plus bas
- Je vous conseille aussi d'éviter les espaces et/ou accents dans le nom des feuilles surtout si vous faites appel à VBA. Vous risquez d'avoir parfois des bug sans trop savoir d'où cela vient. utilisez le souligné ou le tiret -- > Nouveau_devis, ou Base_devis

Cordialement

Le 04/01/2022 à 10:46

Dan,

Super, ça tourne parfaitement.

Merci pour tes conseils, j'aurai tout de même une question. Peux-tu, comme tu l'as fais pour l'adressage, m'indiquer en vert comment tu as construit le code sur les conditions de recherches (colonne + P00XX) stp ?

Je dois réaliser la même gymnastique pour créer un module Facture et je veux comprendre pour le faire moi-même :) .

Merci.

Le 04/01/2022 à 11:01

Merci pour tes conseils, j'aurai tout de même une question. Peux-tu, comme tu l'as fais pour l'adressage, m'indiquer en vert comment tu as construit le code sur les conditions de recherches (colonne + P00XX) stp ?

Voici les explications du code

Sub Enregistrer()
Dim col As Integer, lig As Integer
Dim i As Byte

With Sheets("Base Devis")
    'gestion erreur au cas au col = 0
    On Error Resume Next
    'variable col : verifier si colonne existe dans feuille Base devis par rapport au numéro de devis en feuille Nouveau Devis
    col = .Rows("1:1").Find(Format(Sheets("Nouveau Devis").Range("H4").Value, "00000"), LookIn:=xlValues, lookat:=xlWhole).Column
    'si col = 0 on cherche la dernière colonne vide en ligne 1
    If col = 0 Then col = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
    'annule la gestion d'erreur
    On Error GoTo 0
    'on remplit les cellules dans chaque ligne sur base de la valeur Col trouvée --> cells(Ligne, col)
    .Cells(1, col).Value = Sheets("Nouveau Devis").Range("H4").Value 'num
    .Cells(1, col).NumberFormat = "00000" 'format de la cellule numero devis dans feuille base devis
    .Cells(2, col) = Sheets("Nouveau Devis").Range("F13").Value 'client
    .Cells(3, col) = Sheets("Nouveau Devis").Range("H5").Value 'Date devis
    .Cells(4, col) = Sheets("Nouveau Devis").Range("H16").Value 'Date valid
    .Cells(5, col) = Sheets("Nouveau Devis").Range("H42").Value 'Acompte
    .Cells(6, col) = Sheets("Nouveau Devis").Range("H43").Value 'Mi chantier
    .Cells(7, col) = Sheets("Nouveau Devis").Range("D39").Value 'Mi chantier
    .Cells(8, col) = Sheets("Nouveau Devis").Range("D16").Value 'Adresse travaux
    .Cells(9, col) = Sheets("Nouveau Devis").Range("H39").Value 'total HT

    'boucle pour completer les valeurs Pxxxx dans feuille Base devis
    For i = 1 To 18
        'vérifier si une valeur Pxxxxx existe dans la colonne C. Si pas de valeur on sort de la macro
        If Sheets("Nouveau Devis").Range("C" & i + 18).Value = "" Then Exit Sub
        'gestion d'erreur en cas de lig = 0
        On Error Resume Next
        'variable lig : trouver lig dans feuille Base devis en fonction de valeur Pxxxx trouvée dans feuille Nouveau Devis
        lig = .Range("A:A").Find(Sheets("Nouveau Devis").Cells(i + 18, 3).Value, LookIn:=xlValues, lookat:=xlWhole).Row
        'si Pxxx n'est pas trouvée --> lig = 0. on reçoit un message que le code n'est pas trouvé en feuille Base devis
        If lig = 0 Then MsgBox "le code article n'existe pas en feuille Base devis"
        'remplir la cellule dans la ligne trouvée des quantités mentionnées en F de la feuille Nouveau devis
        .Cells(lig, col) = Sheets("Nouveau Devis").Range("F" & i + 18).Value
        ' valeur i suivante
    Next i
End With
End Sub

NB : j'ai ajouté une ligne dans le code pour le format du numéro de devis dans la feuille Base devis

Si besoin n'hésitez pas.

Si ok

Le 04/01/2022 à 11:36

Merci Dan.

Je clos ce sujet mais je viens en MP sur une problématique de la fonction Index Equiv liée au même tableau.

Rechercher des sujets similaires à "archivage colonne double criteres"