Rassemblement de 2 code VBA + Eviter de faire une boucle depuis le départ

Bonsoir à tous,

Je possède deux codes VBA que voici :

Sub test()

Dim val As String, valad As String

Sheets("Histo").Range("J4:M3000").Select
Do Until ActiveCell.Value = ""
val = ActiveCell.Value
valad = ActiveCell.Address
flag = True
Do While val = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
If flag = False Then
ActiveCell.Offset(-1, 0).ClearContents
End If
flag = False
Loop
ActiveCell.Offset(-1, 0).Select
Range(valad, ActiveCell.Address).Select
With Selection
.Merge
.MergeCells = True
.VerticalAlignment = xlTop
End With
ActiveCell.Offset(1, 0).Select
Loop

End Sub
Sub test2()

Dim val As String, valad As String

Sheets("Histo").Range("K4:K3000").Select
Do Until ActiveCell.Value = ""
val = ActiveCell.Value
valad = ActiveCell.Address
flag = True
Do While val = ActiveCell.Value
ActiveCell.Offset(1, 0).Select
If flag = False Then
ActiveCell.Offset(-1, 0).ClearContents
End If
flag = False
Loop
ActiveCell.Offset(-1, 0).Select
Range(valad, ActiveCell.Address).Select
With Selection
.Merge
.MergeCells = True
.VerticalAlignment = xlTop
End With
ActiveCell.Offset(1, 0).Select
Loop

End Sub

Cela me permet de fusion des mêmes lignes entre elles.

1) Comment les rassembler pour en faire qu'une et en même temps ?

2) Comment éviter qu'elles repartent depuis la 4ième ligne mais plutôt de la dernière ligne non vide ?

Merci de votre aide,

Bien à vous en cette période,

Storm28

Salut,

Pas de fichier-modèle = pas de réponse ??

Amicalement.

Bonjour,

Avec VBA, chaque fois que c'est possible (i.e quasiment toujours), il faut bannir l'utilisation de .Select, Selection, ActiveCell, et de façon générale tous les objets actifs. Il vaut mieux définir nommément les objets sur lesquels on travaille.

Autre dit, il faut apprendre à écrire du code propre.

Bonjour à tous,

Ci-joint à ce poste, une fichier de test avec les macros en bouton Colonne J et Colonne K.

Merci de votre aide,

Bonjour,

La fusion de cellules est l'ennemi d'une base de données !

Mais ...

Sub test()
Dim noL As Long, drL As Long, pLJ As Long, pLK As Long
Dim vcJ As Variant, fcJ As String, vcK As Variant, fcK As String

  Application.ScreenUpdating = False
  With Worksheets("Histo")
    drL = .Cells(Rows.Count, "A").End(xlUp).Row
    pLJ = 4:                        pLK = 4
    vcJ = .Cells(pLJ, "J").Value:   vcK = .Cells(pLJ, "K").Value
    fcJ = .Cells(pLJ, "J").Formula: fcK = .Cells(pLJ, "K").Formula
    For noL = 4 To drL
      If .Cells(noL + 1, "J").Value <> vcJ Then
        With .Range(.Cells(pLJ, "J"), .Cells(noL, "J"))
          .ClearContents
          .Merge
          .Formula = fcJ
        End With
        pLJ = noL + 1
        vcJ = .Cells(pLJ, "J").Value
        fcJ = .Cells(pLJ, "J").Formula
      End If
      If .Cells(noL + 1, "J").Value <> vcJ Or _
         .Cells(noL + 1, "K").Value <> vcK Then
        With .Range(.Cells(pLK, "K"), .Cells(noL, "K"))
          .ClearContents
          .Merge
          .Formula = fcK
        End With
        pLK = noL + 1
        vcK = .Cells(pLK, "K").Value
        fcK = .Cells(pLK, "K").Formula
      End If
    Next noL
  End With

End Sub

Merci beaucoup pour votre aide,

Mais parfois, j'ai des cellules qui seront déjà fusionnées.

Comment je peux faire pour garder les cellules déjà fonctionnées et renouveler l'opération pour la commande qui a été ajouter ?