correction de code

[hicham28]

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

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

 

[hicham28]

Re : correction de code

Bonjour et merci a vous tous de m'avoir aider, le deuxième choix a bien résolu mon problème, merci.
Une petite question,
Comment je peu intégrer sur le même code l'ajoute d'une nouvelle linge avant de copier les données au niveau de la feuille "banque".
Merci a vous

 

[Habitude]

Re : correction de code

La fonction Offset Permet un positionnement

Offset (ligne, colonne)

Donc Offset(0,0) met la valeur dans la cellule sélectionner
(1,0) met la valeur dans la ligne suivant la ligne sélectionner.

Alors pour passer une ligne
Ajoute +1 à ton offset.

Par contre tes recherches XLDown ne fonctionneront plus
Tu devra faire des XLUp

Range("C65536").End(xlUp).Offset(1[COLOR="Red"]+1[/COLOR], 0).Value = Numero.Value
Range("[COLOR="red"]A65536[/COLOR]").Offset.End([COLOR="red"]xlUp[/COLOR]).Offset(1[COLOR="red"]+1[/COLOR], 0).Select

 

[hicham28]

Re : correction de code

Merci pour votre réponse,
Ça n'as pas marcher, ce que j'aimerai c'est d'ajouter une linge après la dernière linge non vide , et faire coller les données apres, vue que je met d'autres fonctions en bas de la page,
le code que vous m'avez fourni, me fais placer données copié apres ces linges ou j'ai des fonctions, et avec un saut d'une linge a chaque collage de donnée effectué.
La colonne B pourra constitué une référence pour chercher la dernière linge non vide.
J’espère être un peu claire, merci

 

[Habitude]

Re : correction de code

Tu as d'autre fonction en bas....
donc a essayer je n'ai pas testé

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
[COLOR="Red"]Selection.Offset(-2, 0).EntireRow.Insert[/COLOR]
Range("A3").CurrentRegion.Select 'Sélection de la zone en cours

 

[hicham28]

Re : correction de code

merci de me repondre,
nn ca n'as pas marché, j'arrive meme pas a savoir comment t'expliqué le resultat du code que tu ma donner, merci

 

[Habitude]

Re : correction de code

ca irait mieux avec un fichier ...