XL 2013 Amélioration macro

  • Initiateur de la discussion Initiateur de la discussion jejeg
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

jejeg

XLDnaute Nouveau
Bonjour à tous,

Je souhaite améliorer la macro d'un fichier (en pièce jointe).

Le fichier me permet de mettre en ligne double des écritures. Actuellement, je n'ai réussi qu'à reporter que ma colonne "D" qui s'affiche sous forme de ligne double à chaque donnée du tableau.

1 - Comment rajouter du code pour que mes lignes doubles continuent plus bas avec mes données des colonnes "E" et "F" ?

2 - Y a-t-il un code particulier à ajouter pour que la macro ne tienne pas compte des cellules vides ?

Merci d'avance de vos réponses.
Ci-dessous, le code de la macro.
Djé

Code:
Dim encours


Sub MarcoTest()

If encours = True Then Exit Sub

If MsgBox("Mettre en forme les données ?", vbYesNo, "Lancer?") = vbYes Then

Application.Cursor = xlWait
encours = True
deb = 2
l = deb
piece = ActiveWorkbook.Sheets("Feuil1").Range("H1").Value
compteC = ActiveWorkbook.Sheets("Feuil1").Range("I1").Value


ActiveWorkbook.Sheets("MiseEnForme").Range("A12:I10000").Clear

For a = 4 To 22

'RECETTE1
If Len(ActiveWorkbook.Sheets("Feuil1").Range("B" & a).Value) > 0 Then
n = 0
'date
ActiveWorkbook.Sheets("MiseEnForme").Range("B" & (l + n)).Value = ActiveWorkbook.Sheets("Feuil1").Range("B" & a).Value
'Pièce
ActiveWorkbook.Sheets("MiseEnForme").Range("C" & (l + n)).Value = piece
'Compte
ActiveWorkbook.Sheets("MiseEnForme").Range("D" & (l + n)).Value = ActiveWorkbook.Sheets("Feuil1").Range("D2").Value
'Tiers
ActiveWorkbook.Sheets("MiseEnForme").Range("E" & (l + n)).Value = ""
'Ref
ActiveWorkbook.Sheets("MiseEnForme").Range("F" & (l + n)).Value = ""
'libellé
ActiveWorkbook.Sheets("MiseEnForme").Range("G" & (l + n)).Value = ActiveWorkbook.Sheets("Feuil1").Range("D1").Value
'debit
ActiveWorkbook.Sheets("MiseEnForme").Range("H" & (l + n)).Value = "0"
'credit
ActiveWorkbook.Sheets("MiseEnForme").Range("I" & (l + n)).Value = ActiveWorkbook.Sheets("Feuil1").Range("D" & a).Value

'CONTREPARTIES_RECETTES1
If Len(ActiveWorkbook.Sheets("Feuil1").Range("B" & a).Value) > 0 Then
n = n + 1
'date
ActiveWorkbook.Sheets("MiseEnForme").Range("B" & (l + n)).Value = ActiveWorkbook.Sheets("Feuil1").Range("B" & a).Value
'Pièce
ActiveWorkbook.Sheets("MiseEnForme").Range("C" & (l + n)).Value = piece
'Compte
ActiveWorkbook.Sheets("MiseEnForme").Range("D" & (l + n)).Value = compteC
'Tiers
ActiveWorkbook.Sheets("MiseEnForme").Range("E" & (l + n)).Value = ""
'Ref
ActiveWorkbook.Sheets("MiseEnForme").Range("F" & (l + n)).Value = ""
'libellé
ActiveWorkbook.Sheets("MiseEnForme").Range("G" & (l + n)).Value = ActiveWorkbook.Sheets("Feuil1").Range("D1").Value
'debit
ActiveWorkbook.Sheets("MiseEnForme").Range("H" & (l + n)).Value = ActiveWorkbook.Sheets("Feuil1").Range("D" & a).Value
'credit
ActiveWorkbook.Sheets("MiseEnForme").Range("I" & (l + n)).Value = "0"
DoEvents
End If

l = l + n + 1
Else
Exit For
End If

DoEvents
Next a

ActiveWorkbook.Sheets("MiseEnForme").Activate
ActiveWorkbook.Sheets("MiseEnForme").Range(Cells(deb - 1, 2).Address() & ":" & Cells(l, 9).Address()).Select
Selection.Copy
encours = False
DoEvents
Application.Cursor = xlDefault
End If
End Sub
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
671
Réponses
4
Affichages
654
Réponses
2
Affichages
311
Retour