Lire une macro

bonjour a tous

j'ai une macro que l'on ma passer qui fonctionne tres bien

Sub valider_nouvelle_donnée()

Dim nd(4), i%, fin&

With ActiveSheet

For i = 0 To 4

nd(i) = .Cells(8, (i + 1) * 2).Value

If nd(i) = "" Then

MsgBox .Cells(6, (i + 1) * 2).Value & " manquante.", vbInformation, "Erreur nouvelle donnée"

Exit Sub

End If

Next i

End With

Application.ScreenUpdating = False

With Worksheets("BASE")

If Application.CountIf(.Columns("G"), nd(4)) = 0 Then

.Rows(7).Insert

.Cells(8, 6).Copy

.Cells(7, 6).PasteSpecial xlPasteFormulas

For i = 0 To 3

.Cells(7, i + 2).Value = nd(i)

Next i

.Cells(7, 7).Value = nd(4)

With .Range("B7:G7")

With .Borders(xlInsideVertical)

.LineStyle = xlContinuous

.Weight = xlThin

End With

For i = 7 To 10

With .Borders(i)

.LineStyle = xlContinuous

.Weight = xlMedium

End With

Next i

End With

fin = .Range("G" & .Rows.Count).End(xlUp).Row

.Range("B7:G" & fin).Sort key1:=.Range("G7"), order1:=xlAscending, Header:=xlNo

MsgBox ("ENREGISTREMENT REUSSI."), vbExclamation, "Enregistrement nouvelle donnée"

Else

MsgBox "Cet emplacement existe déjà !" & Chr(10) & "Changez d'emplacement.", vbCritical, "Erreur d'emplacement"

Exit Sub

End If

End With

Application.ScreenUpdating = True

Worksheets("nouvelle ref").Range("B8,D8,F8,H8,J8").ClearContents

End Sub

problème je n'arrive pas a la décrypté correctement

un coup de main serrait la bien venue

je joins un fichier ex...

Cordialement

Aiglon74

Bonjour Aiglon, bonjour le forum,

le code commenté :

Sub valider_nouvelle_donnée()
Dim nd(4), i%, fin& 'définit les variables nd (tableau 5 variables de 0 a 4), i et fin. Le tableau nd est de type Variant, i de type integer (%), fin de type long (&)

With ActiveSheet 'prend en compte l'onglet actif
    For i = 0 To 4 'boucle de 0  à 4
        nd(i) = .Cells(8, (i + 1) * 2).Value 'définit la variable nd(i) en fonction de la cellule ligne 8, colonne (i plus un) fois deux
        If nd(i) = "" Then 'condition : si nd(i) est vide
            MsgBox .Cells(6, (i + 1) * 2).Value & " manquante.", vbInformation, "Erreur nouvelle donnée" 'message
            Exit Sub 'sort de la procédure
        End If 'fin de la condition
    Next i 'prochaine valeur de la boucle
End With 'fin de la prise en compte de l'onglet actif

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran

With Worksheets("BASE") 'prend en compte l'onglet "BASE"

    If Application.CountIf(.Columns("G"), nd(4)) = 0 Then 'condition 1 : si le nombre d'occurrences de nd(4) dans la colonne G est égal a zéro
        .Rows(7).Insert 'ins1ere une ligne (au niveau de la ligne 7)
        .Cells(8, 6).Copy 'copie la cellule ligne 8, colonne 6 (=F)
        .Cells(7, 6).PasteSpecial xlPasteFormulas 'colle la formule ligne 7 colonne 6 (=F)
        For i = 0 To 3 'boucle de 0 à 3
            .Cells(7, i + 2).Value = nd(i) 'récupère dans la cellule ligne 7, colonne I plus 2, la valeur de la variable nd(i)
        Next i 'prochaine valeur de la boucle
        .Cells(7, 7).Value = nd(4) 'renvoie dans la cellule ligne 7, colonne 7 (=G), la valeur de la variable nd(4)
        'mise en forme au niveau des bordures
        With .Range("B7:G7")
            With .Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
            For i = 7 To 10
                With .Borders(i)
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                End With
            Next i
        End With
        fin = .Range("G" & .Rows.Count).End(xlUp).Row 'définit la variable fin (dernière ligne éditée de la colonne G)
        .Range("B7:G" & fin).Sort key1:=.Range("G7"), order1:=xlAscending, Header:=xlNo 'tri ascendant des cellules B7 à G..fin avec la cellue G7 comme point de départ
        MsgBox ("ENREGISTREMENT REUSSI."), vbExclamation, "Enregistrement nouvelle donnée" 'message

    Else 'sinon (ccondition 1)

        MsgBox "Cet emplacement existe déjà !" & Chr(10) & "Changez d'emplacement.", vbCritical, "Erreur d'emplacement" 'message
        Exit Sub 'sort de la procédure
    End If 'fin de la condition 1

End With 'fin de la prise en compte de l'onglet "BASE"

Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
Worksheets("nouvelle ref").Range("B8,D8,F8,H8,J8").ClearContents 'efface le contenu des cellules B8, D8, F8, H8, J8 de l'onglet "nouvelle ref"
End Sub

Bonjour ThauThèmee

merci pour toute ces explications

je voudrais inversé la colonne J et la colonne B

pour le moment si je marque AA1 dans la colonne J un message apparait c'est emplacement excite déjà

je voudrais que ca soit en colonne B

je change quoi dans la macro

Bonjour, c'est cette partie du code qui compare la colonne G (feuille liste) à ton tableau nd (nd(4) correspond à la valeur récupérée en J8 (feuille 'nouvelle ref') et qui signale si l'emplacement est pris ou inexistant).

If Application.CountIf(.Columns("G"), nd(4)) = 0 Then

...

Else 

        MsgBox "Cet emplacement existe déjà !" & Chr(10) & "Changez d'emplacement.", vbCritical, "Erreur d'emplacement" 
        Exit Sub 
    End If 

Si tu veux que la comparaison se fasse par rapport à la désignation, il faut changer le numéro dans le nd (nd(0) et comparer par rapport à la colonne B de la feuille "BASE". Il suffit de se baser sur ce code et l'adapter avec des messages correspondants (je pense que tu veux conserver le système de messages de l'EMPLACEMENT, non ?

Oula, fin de journée, je commence à lire de travers ... tu veux juste changer l'emplacement de la cellule dans laquelle tu veux introduire les données ?

Bonjour le fil, bonjour le forum,

Pas très clair pour moi non plus... Le code tourne sur trois onglets différents, il te faudra être plus clair l'Aiglon...