XL 2013 Amélioration macro

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

  • MacroTest.xlsm
    20.8 KB · Affichages: 26
  • MacroTest.xlsm
    20.8 KB · Affichages: 29

Statistiques des forums

Discussions
312 165
Messages
2 085 883
Membres
103 014
dernier inscrit
moimoi31