Contrepartie comptable

Bonjour,

J'ai un fichier de règlements clients (feuille 1), j'aimerai créer un fichier d'import automatique (en feuille 2 ce que j'arrive à obtenir avec la macro actuelle).

Cependant je n'arrive pas à créer les lignes de contrepartie à mettre au débit en fonction du mode de règlements. J'ai indiqué dans la feuille 3 ce que j'aimerai obtenir.

Ci-joint un fichier d'exemple réduit (le fichier de base possède une centaine de ligne en moyenne).

Merci à vous pour votre aide !

Bonjour,

Un essai ...

Sub reglements()
Dim oShAcc As Worksheet
Dim oShRegl As Worksheet
Dim iLig As Integer
Dim iCol As Integer
Dim iEcr As Integer
Dim iDerLig As Integer
Dim dernièreligne As Variant

   Set oShAcc = ThisWorkbook.Worksheets("Feuil1")
   Set oShRegl = ThisWorkbook.Worksheets("Reglements")

   'efface les données précédentes
   iDerLig = oShRegl.Range("A" & Rows.Count).End(xlUp).Row

   If iDerLig >= 4 Then
      oShRegl.Rows("4:" & iDerLig).ClearContents
   End If

   'parcours les donnnées
   dernièreligne = oShAcc.Cells(5, "A").End(xlDown).Row   'défini en descendant la première ligne vide de la colonne A

   For iLig = 5 To dernièreligne
      iEcr = oShRegl.Range("A" & Rows.Count).End(xlUp).Row + 1

      'date
      oShRegl.Range("A" & iEcr).Value = oShAcc.Range("E" & iLig)
      oShRegl.Range("A" & iEcr + 1).Value = oShAcc.Range("E" & iLig)

      'piece
      oShRegl.Range("B" & iEcr).Value = oShAcc.Range("D" & iLig)
      oShRegl.Range("B" & iEcr + 1).Value = oShAcc.Range("D" & iLig)

      'compte
      oShRegl.Range("C" & iEcr).Value = oShAcc.Range("B" & iLig)
      If oShAcc.Range("C" & iLig) = "Carte Bancaire" Then
         oShRegl.Range("C" & iEcr + 1).Value = 51120000
         oShRegl.Range("E" & iEcr + 1).Value = oShAcc.Range("J" & iLig).Value      'débit
      End If
      If oShAcc.Range("C" & iLig) = "Chèque" Then
         oShRegl.Range("C" & iEcr + 1).Value = 51130000
         oShRegl.Range("E" & iEcr + 1).Value = oShAcc.Range("J" & iLig).Value      'débit
      End If
      If oShAcc.Range("C" & iLig) = "Virement" Then
         oShRegl.Range("C" & iEcr + 1).Value = 51140000
         oShRegl.Range("E" & iEcr + 1).Value = oShAcc.Range("J" & iLig).Value      'débit
      End If

      'libellé
      oShRegl.Range("D" & iEcr).Value = oShAcc.Range("F" & iLig).Value
      oShRegl.Range("D" & iEcr + 1).Value = oShAcc.Range("F" & iLig).Value

      'crédit
      oShRegl.Range("F" & iEcr).Value = oShAcc.Range("J" & iLig).Value
   Next iLig

   oShRegl.Activate
   oShRegl.Range("A4").Select   'se place sur la celulle A4 à la fin du traitement

   MsgBox "Import terminé !", vbExclamation

   Set oShAcc = Nothing
   Set oShRegl = Nothing
End Sub

ric

Parfait !!! Merci beaucoup

ric