correction de code

hicham28 · 6 Juin 2010

Bonsoir a vous,
J’ai besoin a nouveau de votre aide, et je vous remercie d'avance,
Ce que je comprends pas c'est que ce code marche correctement pour la première partie ( la partie cheque), mais il y'as un problème au niveau de la deuxième partie(partie lettre de change), qui se résume que le transfert s'effectue sur deux linges, alors que normalement tous dois être copier sur une seule linge. Merci de votre aide

Code:

Private Sub Enregister_Click()
Dim varDoublon As Variant
If Reglement.Value = "CHEQUE" Then
    Sheets("cheque").Activate
    Range("E1").Value = Montant.Value
    Range("B4").Value = Beneficaire.Value
    Range("G1").Value = Numero.Value
    Range("H1").Value = Cause.Value
    Sheets("Effet_emis").Activate 'Sélection de l'onglet Effets_emis
    Range("g3").NumberFormat = "[Red]-#,##0.00 """""
    Range("g3").HorizontalAlignment = xlRight
    Range("K3:Q3").Copy  'Copie des cellules K3 a Q3
    Sheets("bmce").Activate
    On Error Resume Next
    Columns(3).Find(Numero.Value, , xlValues, xlWhole).Select
    If Err.Number Then
        Range("C65536").End(xlUp).Offset(1, 0).Value = Numero.Value
        Range("A3").Offset.End(xlDown).Offset(1, 0).Select    'Sélection de la cellule en dessous du dernier enregistrement de la colonne A
               'Coller valeur
    Selection.PasteSpecial Paste:=xlValues, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("A3").CurrentRegion.Select  'Sélection de la zone en cours
    Range("A3").Select 'Sélection de la cellule A1
    Else
        MsgBox "Cette valeur existe déjà", vbExclamation, ThisWorkbook.Name
    End If
    End If
If Reglement.Value = "LETTRE DE CHANGE" Then
Sheets("effet").Activate
    Range("G1").Value = Numero.Value
    Range("C2").Value = Beneficaire.Value
    Range("F4").Value = Echeance.Value
    Range("F6").Value = Montant.Value
    Range("C6").Value = Cause.Value
    Sheets("Effet_emis").Activate 'Sélection de l'onglet Effets_emis
    Range("K2:P2").Copy  'Copie des cellules I2 à N2
    On Error Resume Next
    Columns(1).Find(Numero.Value, , xlValues, xlWhole).Select
    If Err.Number Then
        Range("A65536").End(xlUp).Offset(1, 0).Value = Numero.Value
        Range("A3").Offset.End(xlDown).Offset(1, 0).Select    'Sélection de la cellule en dessous du dernier enregistrement de la colonne A
     'Coller valeur
    Selection.PasteSpecial Paste:=xlValues, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("A1").CurrentRegion.Select  'Sélection de la zone en cours
    Range("A1").Select 'Sélection de la cellule A1
    Else
        MsgBox "Cette valeur existe déjà", vbExclamation, ThisWorkbook.Name
    End If
  End If
If Reglement.Value = "" Then
MsgBox ("vous devez choisir une feuille")
End If
End Sub

kjin · 6 Juin 2010

Re : correction de code

Bonsoir,
Joindre Mme Irma [thread=32841]06 22 22 22 22,[/Thread], elle est en général d'un bon secours si tu sais t'y prendre
A+
kjin

camarchepas · 6 Juin 2010

Re : correction de code

Bonsoir ,

commence par virer le on error resume next , grr, ça ne met que le bazar

hicham28 · 6 Juin 2010

Re : correction de code

merci c gentil de votre part, mais comment je pourrai gerer les doublons?

camarchepas · 6 Juin 2010

Re : correction de code

Re ,

tu déclares :
dim Trouve as object

puis

Range("K2😛2").Copy 'Copie des cellules I2 à N2
Set trouve = Columns(1).Find("Numero.Value", , xlValues, xlWhole)
If trouve Is Nothing Then
Range("A65536").End(xlUp).Offset(1, 0).Value = "Numero.Value"

hicham28 · 6 Juin 2010

Re : correction de code

merci, j'arrive pas a, je n'y arrive pas dsl, tu peu stp me copier le nouveau code? merci

camarchepas · 6 Juin 2010

Re : correction de code

Voici le code modifié,

Option Explicit

Private Sub Enregister_Click()
Dim varDoublon As Variant
Dim Trouve As Object

If Reglement.Value = "CHEQUE" Then 'Reglement.Value
Sheets("cheque").Activate
Range("E1").Value = Montant.Value
Range("B4").Value = Beneficaire.Value
Range("G1").Value = Numero.Value
Range("H1").Value = Cause.Value
Sheets("Effet_emis").Activate 'Sélection de l'onglet Effets_emis
Range("g3").NumberFormat = "[Red]-#,##0.00 """""
Range("g3").HorizontalAlignment = xlRight
Range("K3:Q3").Copy 'Copie des cellules K3 a Q3
Sheets("bmce").Activate
Set Trouve = Columns(3).Find(Numero.Value, , xlValues, xlWhole)
If Trouve Is Nothing Then
Range("C65536").End(xlUp).Offset(1, 0).Value = Numero.Value
Range("A3").Offset.End(xlDown).Offset(1, 0).Select 'Sélection de la cellule en dessous du dernier enregistrement de la colonne A
'Coller valeur
Selection.PasteSpecial Paste:=xlValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("A3").CurrentRegion.Select 'Sélection de la zone en cours
Range("A3").Select 'Sélection de la cellule A1
Else
MsgBox "Cette valeur existe déjà", vbExclamation, ThisWorkbook.Name
End If
End If
If Regle = "LETTRE DE CHANGE" Then
Sheets("effet").Activate
Range("G1").Value = Numero.Value
Range("C2").Value = Beneficaire.Value
Range("F4").Value = Echeance.Value
Range("F6").Value = Montant.Value
Range("C6").Value = Cause.Value
Sheets("Effet_emis").Activate 'Sélection de l'onglet Effets_emis
Range("K2😛2").Copy 'Copie des cellules I2 à N2
Set Trouve = Columns(1).Find(Numero.Value, , xlValues, xlWhole)
If Trouve Is Nothing Then
Range("A65536").End(xlUp).Offset(1, 0).Value = "Numero.Value"
Range("A3").Offset.End(xlDown).Offset(1, 0).Select 'Sélection de la cellule en dessous du dernier enregistrement de la colonne A
'Coller valeur
Selection.PasteSpecial Paste:=xlValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").CurrentRegion.Select 'Sélection de la zone en cours
Range("A1").Select 'Sélection de la cellule A1
Else
MsgBox "Cette valeur existe déjà", vbExclamation, ThisWorkbook.Name
End If
End If
If "Reglement.Value" = "" Then
MsgBox ("vous devez choisir une feuille")
End If
End Sub

phlaurent55 · 7 Juin 2010

Re : correction de code

Bonjour à tous,

@ hicham,
il y a déjà pas mal d'incohérences dans le code

Code:

    Range("[COLOR=red][B]K2:P2[/B][/COLOR]").Copy  [COLOR=red][B]'Copie des cellules I2 à N2[/B][/COLOR]
    ...................   
[COLOR=blue]Range("A3").CurrentRegion.Select 'Sélection de la zone en cours[/COLOR]
[COLOR=blue]Range("[B][COLOR=red]A3[/COLOR][/B]").Select 'Sélection de la cellule [/COLOR][B][COLOR=red]A1 [/COLOR][/B]
......................
[COLOR=blue] Range("A1").CurrentRegion.Select  'Sélection de la zone en cours[/COLOR]
[COLOR=blue] Range("A1").Select 'Sélection de la cellule A1[/COLOR]

pourquoi sélectionner une zone et ensuite une cellule

je pense qu'il vaudrait mieux joindre le fichier ( sans données confidentielles) avec explications claires et précises de ce que tu attends afin de nous permettre de comprendre car au vu de tes explications,je doute que tu sois l'auteur du code

à+
Philippe

hicham28 · 7 Juin 2010

Re : correction de code

merci, meme problemes, mais cette fois sur les deux feuilles, merci

hicham28 · 7 Juin 2010

Re : correction de code

J’aimerai bien joindre le fichier, puisque je suis blocké tous le weck end sur ce code, mais ça contient ennoiement de données confidentiel, j'avais un code qui fonctionne correctement, mais le problème as commencer dé que j'ai intégrer un autre code pour éviter la saisie des doublons, voila je vous joint les deux codes.
le premier code

Code:

Private Sub Enregister_Click()
If Reglement.Value = "CHEQUE" Then
    Sheets("cheque").Activate
    Range("E1").Value = Montant.Value
    Range("B4").Value = Beneficaire.Value
    Range("G1").Value = Numero.Value
    Range("H1").Value = Cause.Value
    Sheets("Effet_emis").Activate 'Sélection de l'onglet Effets_emis
    Range("g3").NumberFormat = "[Red]-#,##0.00 """""
    Range("g3").HorizontalAlignment = xlRight
    Range("K3:Q3").Copy  'Copie des cellules K3 a Q3
    Sheets("bmce").Activate
    Range("A3").Offset.End(xlDown).Offset(1, 0).Select    'Sélection de la cellule en dessous du dernier enregistrement de la colonne A
               'Coller valeur
    Selection.PasteSpecial Paste:=xlValues, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("A3").CurrentRegion.Select  'Sélection de la zone en cours
    Range("A3").Select 'Sélection de la cellule A1
    End If
If Reglement.Value = "LETTRE DE CHANGE" Then
Sheets("effet").Activate
    Range("G1").Value = Numero.Value
    Range("C2").Value = Beneficaire.Value
    Range("F4").Value = Echeance.Value
    Range("F6").Value = Montant.Value
    Range("C6").Value = Cause.Value
    Sheets("Effet_emis").Activate 'Sélection de l'onglet Effets_emis
    Range("K2:P2").Copy  'Copie des cellules I2 à N2
    Range("A3").Offset.End(xlDown).Offset(1, 0).Select    'Sélection de la cellule en dessous du dernier enregistrement de la colonne A
     'Coller valeur
    Selection.PasteSpecial Paste:=xlValues, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("A1").CurrentRegion.Select  'Sélection de la zone en cours
    Range("A1").Select 'Sélection de la cellule A1
  End If
If Reglement.Value = "" Then
MsgBox ("vous devez choisir une feuille")
End If
End Sub

code pour les doublons

Code:

Dim varDoublon As Variant
    
    On Error Resume Next
    Columns(1).Find(TextBox1.Value, , xlValues, xlWhole).Select
    If Err.Number Then
        Range("A65536").End(xlUp).Offset(1, 0).Value = TextBox1.Value
    Else
        MsgBox "Cette valeur existe déjà", vbExclamation, ThisWorkbook.Name
    End If

camarchepas · 7 Juin 2010

Re : correction de code

Re ,
Le code est dans un module ou dans une feuille

hicham28 · 7 Juin 2010

Re : correction de code

sur une userform , il es associé a la bouton command enregister comme indiqué sur le code.
merci encore

hicham28 · 7 Juin 2010

Re : correction de code

j'aimerai aussi ajouter une linge apres la derniere linge non vide sur la feuille banque avant de faire coller des elements copié.
merci

Habitude · 7 Juin 2010

Re : correction de code

Macro enregistrer mélangé avec du code trouvé ici et la.

Il semble te manquer une sélection de feuille "activate" juste avant ton On Error Resume Next dans "LETTRE DE CHANGE"

D'abord essaie comme ceci

Code:

Private Sub Enregister_Click()
Dim varDoublon As Variant
If Reglement.Value = "CHEQUE" Then

    With Sheets("cheque")
    .Range("E1").Value = Montant.Value
    .Range("B4").Value = Beneficaire.Value
    .Range("G1").Value = Numero.Value
    .Range("H1").Value = Cause.Value
    End With

   
    With Sheets("Effet_emis")
    .Range("g3").NumberFormat = "[Red]-#,##0.00 """""
    .Range("g3").HorizontalAlignment = xlRight
    .Range("K3:Q3").Copy  'Copie des cellules K3 a Q3
    End With

    With Sheets("bmce")
        
        If Not .Columns(3).Find(Numero.Value, , xlValues, xlWhole) Then
            
            .Range("C" & .Range("C65536").End(xlUp).Row + 1) = Numero.Value
            .Range("A" & .Range("A65536").End(xlUp).Row + 1) _
            .PasteSpecial Paste:=xlValues, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
            .Range("A3").Select 'Sélection de la cellule A1
        
        Else
            MsgBox "Cette valeur existe déjà", vbExclamation, ThisWorkbook.Name
        End If
        
    End With
    End If

Habitude · 7 Juin 2010

Re : correction de code

Bon en regardant le code un peu plus, j'ai compris ton inscription sur 2 lignes.

Code:

If Err.Number Then
        Range("C65536").End(xlUp).Offset(1, 0).Value = Numero.Value
        Range("A3").Offset.End(xlDown).Offset(1, 0).Select    'Sélection de la cellule en dessous du dernier enregistrement de la colonne A
               'Coller valeur
    Selection.PasteSpecial Paste:=xlValues, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False

Dans "CHEQUE"
Tu met ton Numero.Value dans la colonne "C" et tu fais ton paste dans la colonne "A"

Dans "LETTRE DE CHANGE"
Tu met ton Numero.Value dans la colonne "A" et tu fais ton paste aussi dans la colonne "A"
Comme tu te met 2 fois sur la dernière ligne non vide en "A" sur offset (1,0)
Il est normal que tu saute une ligne.

2 choix
Tu as fait une erreur et ton Numero.Value doit aller en "C"

Code:

If Err.Number Then
        Range("[COLOR="Red"]C[/COLOR]65536").End(xlUp).Offset(1, 0).Value = Numero.Value
        Range("A3").Offset.End(xlDown).Offset(1, 0).Select    'Sélection de la cellule en dessous du dernier enregistrement de la colonne A
               'Coller valeur
    Selection.PasteSpecial Paste:=xlValues, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False

Ou si ton numéro doit aller en A
Tu fais ton paste sur offset (0,0)

Code:

If Err.Number Then
        Range("[COLOR="Red"]A[/COLOR]65536").End(xlUp).Offset(1, 0).Value = Numero.Value
        Range("A3").Offset.End(xlDown).Offset[COLOR="red"](0, 0)[/COLOR].Select    'Sélection de la cellule en dessous du dernier enregistrement de la colonne A
               'Coller valeur
    Selection.PasteSpecial Paste:=xlValues, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False

correction de code

hicham28

XLDnaute Occasionnel

kjin

XLDnaute Barbatruc

camarchepas

XLDnaute Barbatruc

hicham28

XLDnaute Occasionnel

camarchepas

XLDnaute Barbatruc

hicham28

XLDnaute Occasionnel

camarchepas

XLDnaute Barbatruc

phlaurent55

Nous a quittés en 2020

hicham28

XLDnaute Occasionnel

hicham28

XLDnaute Occasionnel

camarchepas

XLDnaute Barbatruc

hicham28

XLDnaute Occasionnel

hicham28

XLDnaute Occasionnel

Habitude

XLDnaute Accro

Habitude

XLDnaute Accro

Discussions similaires

correction de code

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

Nous a quittés en 2020

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Accro

XLDnaute Accro

Discussions similaires

Privacy & Transparency

Privacy & Transparency