Fusion automatique conditionnée

PièceJointe

XLDnaute Nouveau
bonsoir à tous...

J'avais initialement posté à la suite d'un fil qui me semblait approprié mais le silence général me dit que je n'ai peut être pas bien fait...

je vient de mettre le nez dans les macro et dans vba... c'est pas simple... voici ce que je souhaite faire :

je souhaite fusionner automatiquement des cellules identiques dans des colonnes identifiées (c'est à dire uniquement dans les colonnes de mon choix : ici les colonnes F K et M et uniquement pour des cellules adjacentes verticalement).

En cadeau bonux, s'il était possible, je souhaiterai que cela se fasse dans une autre feuille afin de conserver la possibilité de trier et de calculer comme bon me semble dans le fichier "source"...

j'ai tenté ce code proposé dans un ancien post sans succès :

'Mes valeurs sont dans la colonne A
Dim Deb As Long

Range("A1").Select
Application.DisplayAlerts = False
Deb = -1
While Not IsEmpty(ActiveCell)
If ActiveCell.Value = ActiveCell.Offset(1).Value Then
If Deb = -1 Then Deb = ActiveCell.Row
Else
If Deb <> -1 Then
With Range("A" & Deb & ":A" & ActiveCell.Row)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.MergeCells = True
End With
Deb = -1
End If
End If
ActiveCell.Offset(1).Select
Wend
Application.DisplayAlerts = True




et celle ci aussi...mais visiblement il y a une "erreur de compilation /erreur de syntaxe" à la ligne :
C1 = Range('A' & i) = Range('B' & i)


Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 06/02/2006 par ADSLHY
'

'
Application.ScreenUpdating = False 'fige l'affichage de l'écran
Application.EnableEvents = False 'Supprime certain message d'alerte windows


For i = 2 To 10 'choisissez de quelle ligne a quel ligne doit ce faire les fusion

'C1 & C2 sont les condition qui permettent de savoir si An=Bn et si Bn=Cn
C1 = Range('A' & i) = Range('B' & i)
C2 = Range('B' & i) = Range('C' & i)

If (C1 = True And C2 = True) Then 'si C1 et C2 sont vrai alors fusion cellule ABCn
Range('B' & i, 'C' & i).Select
Selection.ClearContents
Range('A' & i, 'C' & i).Select 'selection An;Cn
With Selection 'fusion
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Merge
End If
Next i
Application.ScreenUpdating = True

Application.EnableEvents = True

End Sub



Je me repère vaguement dans le code mais en fait j'y comprends rien... Je suis prêt à passer le week end dessus, je vous demande pas un truc tout cuit (quoique je prendrai)...au moins une idée...je suis hyper mal barré et je dois rendre ma copie mardi... Help :)

En Pièce Jointe un exemple de ce sur quoi je travaille...anonymé et réduit à quelques lignes...

Merci de vos conseils...
 

Pièces jointes

  • TEST Fusion1.xls
    37.5 KB · Affichages: 72
  • TEST Fusion1.xls
    37.5 KB · Affichages: 70
  • TEST Fusion1.xls
    37.5 KB · Affichages: 70

tototiti2008

XLDnaute Barbatruc
Re : Fusion automatique conditionnée

pour les 3 colonne F, K et M :


Code:
Sub Macro1()
Dim Debut As Long, i As Long, Valo, j As Long
Dim Tablo
    Tablo = Array("F", "K", "M")
    For j = LBound(Tablo) To UBound(Tablo)
        Debut = 7
        Valo = Worksheets("Général").Range(Tablo(j) & "7").Value
        For i = 8 To Worksheets("Général").Range(Tablo(j) & "65536").End(xlUp).Row + 1
            If Worksheets("Général").Range(Tablo(j) & i).Value <> Valo Then
                Application.DisplayAlerts = False
                With Worksheets("Général").Range(Tablo(j) & Debut & ":" & Tablo(j) & i - 1)
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .Merge
                End With
                Application.DisplayAlerts = True
                Debut = i
                Valo = Worksheets("Général").Range(Tablo(j) & i).Value
            End If
        Next i
    Next j
End Sub
 

Discussions similaires

Statistiques des forums

Discussions
312 587
Messages
2 090 008
Membres
104 344
dernier inscrit
nesrine