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é
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