Test sur une cellule avant la copie

Abdias_bly

XLDnaute Nouveau
Bonjour à tout!!!
je ne suis pas un prof VBA juste un débutant.Je viens vers vous pour exposer mon pb qui paraît simple mais un peu compliqué pour moi.le fichier original est lourd je ne peux le joindre.Mes vos explications m'aideront.Je joint un fichier pour illustration.Je m'explique:
Dans le classeur joint il y a 2 feuilles.Les données de la feuille 1 sont enrégistrées dans la feuille 2 grace à un bouton affecter à une macro.Tout beigne!!!à ce niveau et gros merci à Bruno.Alors mon souci est de poser une condition sur la cellule qui renseigne le N° feuille de la feuille 1 pour éviter l'enrégistrement des doublons.Il s'agist d'effectuer une recherche dans la colonne N° feuille de la feuille 2 pour vérifier si le numéro existe ou pas.Si non,alors effectuer la copie.Si oui,petit message d'erreur du genre"numéro existant".
Merci pour votre contribution
 

Pièces jointes

  • Test.xls
    17 KB · Affichages: 47
  • Test.xls
    17 KB · Affichages: 49
  • Test.xls
    17 KB · Affichages: 47

XL_Luc

XLDnaute Occasionnel
Re : Test sur une cellule avant la copie

Selon ton exemple, voici une fonction qui renvera true si le numéro de feuille existe déjà et false si c'est un nouveau numéro

Code:
Function n_feuille_existe() As Boolean

Set feuille_base = ThisWorkbook.Worksheets("Feuil1")
Set feuille_copie = ThisWorkbook.Worksheets("Feuil2")
n_a_copier = feuille_base.Cells(3, 7)
n_feuille_existe = False

On Error GoTo sortie
 ligne = feuille_copie.Columns("A:A").Find(What:=n_a_copier, After:=feuille_copie.Cells(1, 1), LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Row
n_feuille_existe = True

sortie:
On Error GoTo 0
End Function
 

Abdias_bly

XLDnaute Nouveau
Re : Test sur une cellule avant la copie

par rapport à ton code feuille1=feuille de soins et feuille2=Fiche Client dans le code que je te donne.Le code suivant fonctionne très bien.
Sub fiche()
'
' fiche Macro
' Macro enregistrée le 18/07/2009 par POLAIN

With Sheets("Fiche Client")
Ligne = .Range("A65536").End(xlUp).Row + 1
' Nouveau client = total + 1
.Cells(Ligne, 1) = Sheets("Feuille de soins").Range("K3")
.Cells(Ligne, 2) = Sheets("Feuille de soins").Range("K4")
.Cells(Ligne, 3) = Sheets("Feuille de soins").Range("D6")
.Cells(Ligne, 4) = Sheets("Feuille de soins").Range("H6")
.Cells(Ligne, 5) = Sheets("Feuille de soins").Range("B7")
.Cells(Ligne, 6) = Sheets("Feuille de soins").Range("D7")
.Cells(Ligne, 7) = Sheets("Feuille de soins").Range("G7")
.Cells(Ligne, 8) = Sheets("Feuille de soins").Range("B8")
.Cells(Ligne, 9) = Sheets("Feuille de soins").Range("G8")
.Cells(Ligne, 10) = Sheets("Feuille de soins").Range("E8")
.Cells(Ligne, 11) = Sheets("Feuille de soins").Range("J6")
.Cells(Ligne, 12) = Sheets("Feuille de soins").Range("L6")
.Cells(Ligne, 13) = Sheets("Feuille de soins").Range("C9")
.Cells(Ligne, 14) = Sheets("Feuille de soins").Range("J7")
End With
MsgBox "Données client ajoutées", vbInformation, "C'EST FAIT ..."
End Sub
Alors à quel niveau intégré ce code pour qu'il fonctionne?
j'ai enrégistré le code et dans le code j'ai tapé Call n_feuille_existe tout en haut mais je n'ai rien.
C'est ouvert à tout le monde svp!!!
 

XL_Luc

XLDnaute Occasionnel
Re : Test sur une cellule avant la copie

Alors voila a quoi peut ressembler le code complet :

Code:
Function n_feuille_existe() As Boolean

Set feuille_base = ThisWorkbook.Worksheets("Feuille de soins")
Set feuille_copie = ThisWorkbook.Worksheets("Fiche client")
n_a_copier = feuille_base.Cells(3, 11)
n_feuille_existe = False

On Error GoTo sortie
 ligne = feuille_copie.Columns("A:A").Find(What:=n_a_copier, After:=feuille_copie.Cells(1, 1), LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Row
n_feuille_existe = True

sortie:
On Error GoTo 0
End Function

Sub fiche()
'
' fiche Macro
' Macro enregistrée le 18/07/2009 par POLAIN

if n_feuille_existe then

MsgBox "Données client déjà connue", vbInformation, "RIEN N'EST FAIT ..."
else

With Sheets("Fiche Client")
Ligne = .Range("A65536").End(xlUp).Row + 1
' Nouveau client = total + 1
.Cells(Ligne, 1) = Sheets("Feuille de soins").Range("K3")
.Cells(Ligne, 2) = Sheets("Feuille de soins").Range("K4")
.Cells(Ligne, 3) = Sheets("Feuille de soins").Range("D6")
.Cells(Ligne, 4) = Sheets("Feuille de soins").Range("H6")
.Cells(Ligne, 5) = Sheets("Feuille de soins").Range("B7")
.Cells(Ligne, 6) = Sheets("Feuille de soins").Range("D7")
.Cells(Ligne, 7) = Sheets("Feuille de soins").Range("G7")
.Cells(Ligne, 8) = Sheets("Feuille de soins").Range("B8")
.Cells(Ligne, 9) = Sheets("Feuille de soins").Range("G8")
.Cells(Ligne, 10) = Sheets("Feuille de soins").Range("E8")
.Cells(Ligne, 11) = Sheets("Feuille de soins").Range("J6")
.Cells(Ligne, 12) = Sheets("Feuille de soins").Range("L6")
.Cells(Ligne, 13) = Sheets("Feuille de soins").Range("C9")
.Cells(Ligne, 14) = Sheets("Feuille de soins").Range("J7")
End With
MsgBox "Données client ajoutées", vbInformation, "C'EST FAIT ..."
end if
End Sub
 

Abdias_bly

XLDnaute Nouveau
Re : Test sur une cellule avant la copie

Pour faire plus simple,je vous prie de regarder à la pièce jointe.Vous remarquerez qu'il y a des doublons dans la feuil2 suite à l'ajout via le bouton ajouter.Comment intégrer le code où que faut-il faire pour qu'il n'y ait pas de doublons.Le but étant de ne pas avoir le même numéro dans la colonne N° feuille de la feuil2.
 

Pièces jointes

  • Test.xls
    44 KB · Affichages: 48
  • Test.xls
    44 KB · Affichages: 43
  • Test.xls
    44 KB · Affichages: 47

Abdias_bly

XLDnaute Nouveau
Re : Test sur une cellule avant la copie

XL Luc merci pour ton intervention.J'ai testé le code mais sans suite favorable.Alors si tu te servais du fichier joint dans le précédent message,je pourrais facilement l'intégrer au fichier original.Regarde le code et apporte toutes les modif.Merci d'avance
 
Dernière édition:

Discussions similaires