Microsoft 365 Code VBA

[jebibo]

Bonjour à tous

J'ai un problème avec mon code
Je vous explique

La macro doit jumeler l'onglet facture et l'onglet Crédit cependant la dernière ligne de crédit est manquante lors de l'exécution de la macro.

Pouvez-vous m'indiquer ou est mon erreur.

Merci pour votre attention

 

[Dranreb]

Bonjour.
Incohérence là peut être :
f2.Range("A2:M" & Derlig_f1).Copy

 

[jebibo]

Bonjour Dranreb

ça ne fonctionne pas plus
merci

 

[Dranreb]

Essayez peut être sans calculer préalablement la dernière ligne, genre F2.[A2:M2].Resize(F2.[A1000000].End xlUp).Row - 1).Copy, ça éliminerait pour de bon le risque de prendre une plage d'une feuille jusqu'à la dernière ligne d'une autre feuille …

 

[jebibo]

Je viens de me rendre compte lorsque j'ai moins de ligne dans onglet facture que crédit lorsque j'active la macro cela ne fonctionne pas et si il y a plus de ligne dans facture que crédit cela fonctionne avec la derniere ligne dans crédit

 

[soan]

Bonjour jebibo, Dranreb,

ton fichier en retour.

* clique sur le bouton vert, puis vérifie les résultats.

* clique sur le bouton rouge, puis fais une vérif.

---

note 1 : en plus de la consolidation, j'ai aussi entièrement réécrit et optimisé ta sub EFFACER() ;
attention : cette sub EFFACER() appelle la sub privée Job() ! ne pas supprimer celle-ci !

note 2 : j'ai déclaré au début de Module3 une variable globale m ; cette variable m apparaît
dans EFFACER() puis dans Job() : initialisation, puis utilisation de la valeur de m.

---

code VBA de Module2

Option Explicit

Sub CONVERTIR() 'Consolide_onglets
  If ActiveSheet.Name <> "État_de_Compte" Then Exit Sub
  Dim m&, n&, k&: k = 8
  m = Rows.Count: Application.ScreenUpdating = 0
  n = Cells(m, 2).End(3).Row
  If n > 7 Then
    With Range("A8:M" & n)
      .ClearContents: .Font.ColorIndex = 1
    End With
  End If
  With Worksheets("Factures")
    n = .Cells(m, 2).End(3).Row
    .Range("A2:M" & n).Copy: Cells(k, 1).PasteSpecial -4163
  End With
  k = k + n - 1
  With Worksheets("Crédits")
    n = .Cells(m, 2).End(3).Row
    .Range("A2:M" & n).Copy: Cells(k, 1).PasteSpecial -4163
    Selection.Font.ColorIndex = 3
  End With
  Application.CutCopyMode = 0: [A7].Select
End Sub

---

code VBA de Module3

Dim m& 'm : nombre de lignes maximum

Sub SOMMAIRE()
  'ici, le code VBA de ta sub inchangé
End Sub

Private Sub Job(FX$, k As Byte, chn$)
  Dim n&
  With Worksheets(FX)
    n = .Cells(m, 2).End(3).Row
    If n > k Then .Range(chn & n).ClearContents
  End With
End Sub

Sub EFFACER() 'raccourci clavier: Ctrl+Shift+R
  m = Rows.Count: Application.ScreenUpdating = 0
  Job "Factures", 1, "A2:O": Job "Crédits", 1, "A2:O"
  Job "Sommaire", 8, "B9:E": Job "État_de_Compte", 7, "A8:M"
  [A7].Select
End Sub

soan

 

[jebibo]

Merci Soan
Le fichier fonctionne très bien je vais le revalider en fin de semaine correctement merci pour ton support très apprécier.
Merci également a toi Dranreb pour tes bon conseil
Bonne journée à vous deux