Création de MACROS VBA pour insérer des lignes de TVA automatiquement

Le 22/05/2021 à 23:44

Salut à tous les amis,

J'ai un soucis depuis de plusieurs mois, je vous explique mon soucis.

Je reçois chaque mois un fichier Excel avec en colonne nom prénom mode de règlement, et montant TTC.

Je ne pourrai pas mettre ce fichier car c'est confidentiel mais je mettrais un Excel avec un exemple du type de fichier.

En faite j'aimerais pouvoir pour chaque ligne créer une MACRO qui insère deux ligne et que sa me le mette sur la colonne de droite le montant de TVA et le montant H.T et cela pour chaque ligne jusqu'à qu'il y en plus et que quand ya plus rien cela sarrète tout seul . Il faudrait que cela sois automatique.

Le norme de ligne n'est pas fixe, il peut en avoir 200 comme 100 comme 1500. Il faut donc une macro qui n'est pas fixe mais qui s'adapte et qui se répète tant que il y a un nombre dans la cellule.

Dans le fichier Excel il y a aura dans la feuille 1 le type de fichier que je reçois et dans la feuille 2 a quoi je voudrais que sa ressemble.

34aidez-moi-svp.xlsx (10.83 Ko)

JE VOUS REMERCIE PAR AVANCE.

Le 23/05/2021 à 00:24

Bonjour,

Un code à tester :

Sub TVA()
Application.ScreenUpdating = False
Application.Calculation = xlManual
With ActiveSheet
    L = .Cells(.Rows.Count, 5).End(xlUp).Row + 1
    For I = L To 3 Step -1
        .Rows(I).Resize(2).Insert xlDown
        Application.Union(.Cells(I, 4), .Cells(I + 1, 4), .Cells(I - 1, 5)) = 0
        .Cells(I, 5).FormulaR1C1 = "=R[-1]C[-1]/1.2"
        .Cells(I + 1, 5).FormulaR1C1 = "=R[-2]C[-1]/1.2*0.2"
    Next I
    .Range("D2:E" & .Cells(.Rows.Count, 5).End(xlUp).Row + 1).NumberFormat = "_-* # ##0.00_-;-* # ##0.00_-;_-* "" - ""??_-;_-@_-"
End With
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

Cdlt,

Le 23/05/2021 à 00:32

Merci pour votre réponse rapide, j'essaie sa et si sa fonctionne je mettrais résolu.

Excellente soirée à vous.

Le 23/05/2021 à 00:39

Quand je copie colle la macro et que je l'exécute rien ne se passe. On est d'accord que pour mettre la macro que vous m'avez donner je crée une nouvelle macro et je colle le script et c'est tout ?

Le 23/05/2021 à 00:44

Bonsoir,

Il est nécessaire de lancer la macro depuis la feuille active en l'associant à une forme ou un raccourci à la macro comme par exemple CTRL + SHIFT + E par exemple.

Cdlt,

28copie-de.xlsm (20.46 Ko)
Le 23/05/2021 à 00:47

D'accord, je regarde sa demain et je vous tiens au courant, merci encore.

Bonne soirée.

Le 23/05/2021 à 08:43

Bonjour,

vous serez me dire pourquoi la macro ne marche pas quand les montant son en euros, que dois-je modifier pour que cela marche.

Merci par avance

Le 23/05/2021 à 09:03

alors en fait ce n'est pas votre macro, elle est parfaite, le soucis c'est que en exportant le fichier du client sur Excel les montant se mette en euro mais en fait sa se met un format qui induis en erreur la macro mais quand je change le montant et que je le retape à la main sa fonctionne.

Vous serez m'expliquer ?

15copie-de-2.xlsm (21.60 Ko)
Le 23/05/2021 à 11:40

Bonjour,

Vos "nombres" ne sont pas en format numérique :

Sub TVA()
Dim I%, L%
Application.ScreenUpdating = False
Application.Calculation = xlManual
With ActiveSheet
    L = .Cells(.Rows.Count, 4).End(xlUp).Row + 1
    .Range("D2:D" & L).Replace " €", "", xlPart
    .Range("D2:D" & L).TextToColumns
    For I = L To 3 Step -1
        .Rows(I).Resize(2).Insert xlDown
        Application.Union(.Cells(I, 4), .Cells(I + 1, 4), .Cells(I - 1, 5)) = 0
        .Cells(I, 5).FormulaR1C1 = "=R[-1]C[-1]/1.2"
        .Cells(I + 1, 5).FormulaR1C1 = "=R[-2]C[-1]/1.2*0.2"
    Next I
    .Range("D2:E" & .Cells(.Rows.Count, 4).End(xlUp).Row + 1).NumberFormat = "_-* # ##0.00 €_-;-* # ##0.00 €_-;_-* "" - ""??_-;_-@_-"
End With
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

Par contre pour la valeur en D6 il y a un caractère 160 sur cette valeur 5 496,00 € entre le 5 et le 4 que je n'arrive pas à retirer par VBA. Après 2 heure de recherches et de multiples méthodes essayées (VBA, formule, enregistreur de macro, forums, etc ... )je laisse tomber Je ne pourrais faire plus. Peut être qu'un autre membre aura une idée. Seule la copie de ce caractère et sa suppression par la méthode suivante puis l’exécution de la macro permet d'arriver au résultat escompté.

image

Cdlt,

Le 23/05/2021 à 13:27

Bonjour à tous,

Voici une proposition de fonction obtenir uniquement les chiffres et virgules :

function ExtractNum(chaine$) as double
for i = 1 to len(chaine)
    if not mid(chaine, i, 1) like "[0-9,]" then mid(chaine, i, 1) = " " 'Edit Ergotamine :)
next i
ExtractNum = cdbl(replace(chaine, " ", ""))
end function

Il faut ensuite l'intégrer dans la boucle.

Cdlt,

Le 23/05/2021 à 13:44

Bonjour 3GB,

Merci de ta contribution ! J'ai testé mais ça me sort une incompatibilité de type lorsque je l'intègre à la macro sur la valeur en question et impossible de savoir d'où ça vient. J'ai testé avec ou sans le $ à la fin et même en entrant la fonction dans une cellule, le résultat est #VALEUR.

Je te joins un fichier type avec uniquement la valeur et le code que tu m'as donné car je n'arrive pas à le faire fonctionner correctement. Je ne sais pas ce que c'est que ce caractère, la fonction Asc me renvoie 160 mais je n'arrive pas à l'enlever par formule ou macro ... Peut être aura tu plus de chance car ça reste un mystère et je ne trouve pas la logique/explication ..

10classeur9.xlsm (13.81 Ko)

Cdlt,

PS : Je ne suis pas un expert des fonctions personnalisés, peut être que je suis totalement à côté de la plaque.

Le 23/05/2021 à 14:22

Salut Ergotamine,

Non, c'est normal, c'est moi qui ai mal placé le crochet, rendant la condition remplie à chaque fois et donc une chaine vide, non convertible en double .

J'édite mon code à l'instant !

Sinon, le caractère 160 est un espace insécable. Il est possible de l'enlever en faisant replace(chaine, chr(160), "") ou peut-être application.clean(chaine) (équivalent de la fonction EPURAGE) mais je ne sais plus si ce caractère est pris en compte par cette fonction...

Si jamais tu veux te familiariser aux fonctions, essaie d'abord de les appeler par le code (beaucoup plus simple que sur feuille) en exécutant le code au pas à pas. Grâce à la fenêtre variables locales, tu as un aperçu évolutif des valeurs de chaque variable.

Edit : A noter que tu aurais pu inclure une ligne de plus dans ton code pour remplacer ce caractère :

.Range("D2:D" & L).Replace " €", "", xlPart
.Range("D2:D" & L).Replace chr(160), "", xlPart

Parce que l'utilisation de la fonction, bien qu'adaptée pour tous les cas "normaux", ne s'intègre pas bien au code actuel.

A plus,

Le 23/05/2021 à 14:40

Bonjour,

Je confirme ça fonctionne désormais, je me disais aussi, justement quand j'avais fait en pas à pas détaillé la première fois je voyais mes caractères numériques disparaître 1 à 1 donc j'avais retiré le "Not" sans grande prétention sur mes chances de succès .

Du coup j'ai retiré tous les replaces et texttocolumns je n'en ai plus besoin grâce à la fonction. Ci-contre le code final grâce à la précieuse aide de 3GB !

Sub TVA()
Dim I%, L%
Application.ScreenUpdating = False
Application.Calculation = xlManual
With ActiveSheet
    L = .Cells(.Rows.Count, 4).End(xlUp).Row + 1
    For I = L To 3 Step -1
        .Cells(I - 1, 4) = ExtractNum(.Cells(I - 1, 4))
        .Rows(I).Resize(2).Insert xlDown
        Application.Union(.Cells(I, 4), .Cells(I + 1, 4), .Cells(I - 1, 5)) = 0
        .Cells(I, 5).FormulaR1C1 = "=R[-1]C[-1]/1.2"
        .Cells(I + 1, 5).FormulaR1C1 = "=R[-2]C[-1]/1.2*0.2"
    Next I
    .Range("D2:E" & .Cells(.Rows.Count, 4).End(xlUp).Row + 1).NumberFormat = "_-* # ##0.00 €_-;-* # ##0.00 €_-;_-* "" - ""??_-;_-@_-"
End With
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

Function ExtractNum(chaine$) As Double
Dim I%
For I = 1 To Len(chaine)
    If Not Mid(chaine, I, 1) Like "[0-9,]" Then Mid(chaine, I, 1) = " "
Next I
ExtractNum = CDbl(Replace(chaine, " ", ""))
End Function

En cherchant j'avais vu cette méthode avec la fonction, mais comme je ne maîtrise pas je ne voulais pas m'aventurer là dedans. Ce qui est très étrange c'est que la méthode Replace ne fonctionnait pas, sans comprendre pourquoi, ça me frustre !

Encore merci à 3GB pour la résolution de cette problématique même si je n'ai pas la finalité de l'explication de l'échec du replace !

Cdlt,

21classeur10.xlsm (21.52 Ko)
Le 23/05/2021 à 14:48

je voyais mes caractères numériques disparaître 1 à 1

Oui, moi aussi, je suis dit "mais que se passe-t-il ?" !

Nickel si ça marche, le code me parait mieux ainsi qu'avec la méthode .replace (au cas où il y aurait d'autres caractères imprévus).

Je vais quand même essayer la méthode .replace mais c'est toujours une prise de tête ce caractère 160...

Edit : En effet, on dirait bien que le remplacement n'a pas lieu !

Le 23/05/2021 à 16:25

UN GARND MERCI A TOUS.

c'est vraiment sympa de votre part.

Je vous souhaite a tous une excellente continuation

Rechercher des sujets similaires à "creation macros vba inserer lignes tva automatiquement"