Fusion de cellules VBA

Résolu
Bonjour,

Pour un projet, j'ai besoin de fusionner plusieurs cellule. Je m’explique : l'utilisateur d'un fichier doit fusionner les même ligne de plusieurs colonnes différentes. Ex si il fusionne B11 à B21 il fusionnera toujours D11 à D21 et F11 à F21, etc...
J'aimerais faire un boîte de dialogue pour lui demandé de saisir sa première ligne et sa dernière afin de fusionner les autres.
Avez vous une idée pour faire ça? J'ai essayé plusieurs fonction en vain...
Merci :)

1 réponse

  1. Contributeur
    Bonjour,

    en vba se mettre sur la feuille concernée, faire AltF11 et mettre se code qui se déclenchera au double clic sur une cellule:

    Option Explicit
    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim ref As Range
    Set ref = Application.InputBox(prompt:="Sélectionner les cellules à fusionner sur la feuille", Type:=8)
    Range(ref.Address).Select
    With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Selection.Merge
    End Sub
    
    


    a adapter naturellement
    0
    1. Merci beaucoup pour le code!
      j'ai coler le code mais il ne se déclanche pas au doucle clic, y a t-il une manip a effectuer?
      0
    2. Ducoup j'ai une question : comment induire la fusion des cellules parallèles a celles selectionné : si je sélectionne B2:B6 je voudrais que ca fusion B2:B6 mais aussi E2:E6
      0
    3. Contributeur
      Voilà fusion a 3 colonnes plus loin:

      Option Explicit
      Dim chaine As String
      Dim col As String
      Dim colonne As String
      Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
      On Error Resume Next
      Dim ref As Range
      Set ref = Application.InputBox(prompt:="Sélectionner les cellules à fusionner sur la feuille", Type:=8)
      Range(ref.Address).Select
       Selection.Merge 'B2:B6
      chaine = ref.Address
      extractionMots
      chaine = Replace(chaine, col, colonne) 'remplacer colonne B par E
      Range(chaine).Select
       Selection.Merge 'E2:E6
      End Sub
      'Extraire les données séparées par un  "$" dans une chaine de caractères
      Sub extractionMots()
          Dim Tableau() As String
          Dim i As Integer
         'découpe la chaine en fonction des  "$"
          'le résultat de la fonction Split est stocké dans un tableau
          Tableau = Split(chaine, "$")
          'boucle sur le tableau pour visualiser le résultat
          For i = 0 To UBound(Tableau)
              'Le résultat s'affiche dans la fenêtre d'execution de l'éditeur de macros
              Debug.Print Tableau(i)
          Next i
          col = Tableau(1) 'colonne en lettre
         colonne = AlphaColToNum(col) 'colonne en chiffre
          colonne = Split(Columns(colonne + 3).Address(ColumnAbsolute:=False), ":")(1) 'colonne en lettre + 3 a adapter
      End Sub
      'colonne en chiffre
      Function AlphaColToNum(col As String) As Long
          AlphaColToNum = Range(col & 1).Column
      End Function
      


      Il y a de nombreux commentaires, tu pourras l'adapter a d'autres configurations!

      @+ Le Pivert
      0
    4. Merci beaucoup!!
      Je l'ai adapter sur toutes les colonnes à fusionner, ça marche parfaitement!
      0