Vérification code VBA (recopie plusieurs cellules)

Version imprimable

Bonjour, tout le monde :)
Etant débutant j'ai modifier quelques code que j'ai trouver à gauche à droite...
Très bonne chance :) Il fonctionne :D
mais je me dit qu'il y à sûrement mieux... Ou alors que j'ai fait une petite erreur qui ne pose pas de problème pour le moment...
Vus que c'est pour faire un programme de gestion facturation j'ai intérêt qu'il fonctionne au top.

Le but de la macro :
Recopier plusieurs cellules dans une autre feuilles : base de données
Tbl = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 31, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53)
Ligne assez longue... mais a fonctionne ...

et aussi incrémenter le numéro du devis de 1 à chaque fois

A ce propos : Question N°2 :)
Est ce possible d'incrémenter un numéro mais avec une lettre dedans pour que je puisse m'y retrouver entre les
numéro de facture et les numéro de devis : par exemple au lieu d'avoir 201800001 j'aimerais : D201800001

Voici le code en question :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 Sub Enregistrer_devis() Dim FeFacture As Worksheet Dim FeDevis As Worksheet Dim Tbl Dim Lig As Long Dim I As Integer Set FeFacture = Worksheets("Facture") Set FeMirror = Worksheets("Mirror") Set FeDevis = Worksheets("Devis_2018") 'il est préférable de bien être sûr que "Devis" est entré dans la cellule If UCase(FeFacture.Range("E10").Value) = "DEVIS" Then 'recherche de la première ligne vide dans la base de données With FeDevis: Lig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1: End With 'sur colonne A Tbl = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 31, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53) For I = 0 To UBound(Tbl) FeDevis.Cells(Lig, I + 2).Value = FeMirror.Cells(3, Tbl(I)).Value Next I 'incrémente le numéro client par rapport à la valeur de la cellule du dessus FeDevis.Cells(Lig, 1).Value = FeDevis.Cells(Lig - 1, 1).Value + 1 MsgBox "Enregistrement terminé" Else MsgBox "erreur" End If End Sub
Merci à tous

19/03/2018, 22h41
mjpmjp

bonjour,

Citation:

Est ce possible d'incrémenter un numéro mais avec une lettre dedans

tu traites les chiffres et après tu colles les lettres --> D201800001 -> D 2018 00001

VarNumero = "D201800001"

partie_1 : left(VarNumero,1) --> D
partie_2 : Année --> 2018
partie_3 : right(VarNumero,5) --> 00001

incrémentation
partie_3 = val(partie_3) + 1 --> 00002

reconstruction
VarNumero = partie_1 & "2018" & partie_3 --> D201800002

@+JP
19/03/2018, 23h16
dgeo10

re

Merci, bon j'ai bon tester je ne voit pas comment faire fonctionner sa...
saurais tu me donner le code correct à mettre à la place de mon code actuel ?

'incrémente le numéro client par rapport à la valeur de la cellule du dessus

Code:

FeDevis.Cells(Lig, 1).Value = FeDevis.Cells(Lig - 1, 1).Value + 1

bonjour,

Code:

1
2
3
4
varAncienNuméro=FeDevis.Cells(Lig - 1, 1).Value
varNouveauNumero=val( right(VarAncienNumero,5) ) + 1
 
FeDevis.Cells(Lig, 1).Value="D2018" & varNouveauNumero

tu peut aussi couper en 2 parties

Code:

1
2
3
4
varPartieImmobile=left(FeDevis.Cells(Lig - 1, 1).Value,len(FeDevis.Cells(Lig - 1, 1).Value)-5)
varPartieIncrement=val( right(FeDevis.Cells(Lig - 1, 1).Value,5) ) + 1
 
FeDevis.Cells(Lig, 1).Value = varPartieImmobile & varPartieIncrement

@+JP

bonjour
voyons voir si j'ai bien compris ce que tu veux faire

tu veux copier les cellules d'une ligne(LIG) vers une autre cellule (la premier dispo) dans une autre feuille et ce la de la colonne 1 a 53

si c'est cela regarde bien les exemple qui suivent
tout d'abords ton code comme tel
Code:

1 2 3 4 5 6 'recherche de la première ligne vide dans la base de données With FeDevis: Lig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1: End With 'sur colonne A Tbl = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 31, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53) For I = 0 To UBound(Tbl) FeDevis.Cells(Lig, I + 2).Value = FeMirror.Cells(3, Tbl(I)).Value Next I
pour le simplifier je l'ecrirais comme ca
Code:

1 2 3 4 5 'recherche de la première ligne vide dans la base de données With FeDevis: Lig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1: End With 'sur colonne A For I = 1 To 53 FeDevis.Cells(Lig, I + 1).Value = FeMirror.Cells(3, I).Value Next I
et si je voulais encore plus le simplifier je l'ecrirais comme ca
Code:

1 2 3 4 Destination = FeDevis.Cells(Lig, 2).Resize(1, 53) Source = FeMirror.Cells(3, 1).Resize(1, 53).Value Destination.Value = Source
et!! si je voulais encore encore plus le simplifier je l'ecriarais comme ca

Code:

FeMirror.Cells(Lig, 2).Resize(1, 53).Copy Destination:=FeDevis.Cells(3, 1)

je te suggere de bien regarder chaque code tu comprendra tout seul le dernier
A+

20/03/2018, 12h27
mjpmjp

bonjour,

Patrick le Rétrécisseur :ptdr:

@+JP
20/03/2018, 12h36
dgeo10

Super

Et beh sa pour raccourcir je peut pas demander mieux ahah
Un grand merci je modifie sa dans la journée :D

mjpmjp :

Il marque bien "D2018" ou juste "D" si je le modifie
mais il ne fait pas +1
A chaque fois que je clic sur enregistrer devis, il me marque le même numéro
Code:

1 2 3 4 5 'incrémente le numéro client par rapport à la valeur de la cellule du dessus varAncienNuméro = FeDevis.Cells(Lig - 1, 1).Value varNouveauNumero = Val(Right(VarAncienNumero, 5)) + 1 FeDevis.Cells(Lig, 1).Value = "D" & varNouveauNumero

regarde ce que tu fait!!8O

Code:

1
2
3
4
varAncienNuméro = FeDevis.Cells(Lig - 1, 1).Value
    varNouveauNumero = Val(Right(VarAncienNumero, 5)) + 1
 
    FeDevis.Cells(Lig, 1).Value = "D" & varNouveauNumero

20/03/2018, 13h09
dgeo10

comme dit je ne peut même pas voir l'erreur je connais rien du tout en vba ...
j'ai juste copier coller le code que mjpmjp ma donner ....
donc ok je regarde j'ai bon essayer de modifier cv pas...
21/03/2018, 13h14
mjpmjp

bonjour,
quand tu as ton nouveau numéro ,
n'oublie pas de faire lig=lig + 1 , ... pour changer de ligne et avoir un autre numéro ;)

@+JP