Discussion :

[mika2626]

Bonjour à tous,

J'ai crée un emploi du temps qui se présente de la manière suivante



j'ai le code suivant mais quelque chose ne marche pas, avez vous une idée ??

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
For Each c In Worksheets("Feuil1").Range("B2", Range("IV1").End(xlToLeft))
c.Activate
Application.DisplayAlerts = False
Départ = ActiveCell.Address
Do While ActiveCell.Row < 15
If ActiveCell <> ActiveCell.Offset(1, 0) Then
Range(Départ, ActiveCell.Address).Merge
Départ = ActiveCell.Offset(1, 0).Address
End If
ActiveCell.Offset(1, 0).Activate
Loop
Next

Merci beaucoup

[ARTURO83]

Bonjour,

Je suppose que vous voulez fusionner les cellules identiques d'une même colonne!

Pour Fusionner

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Fusionner()
    Dim DerLig As Long, DerCol As Long, L As Long, C As Long
    Dim Dep As Range
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    DerLig = [A10000].End(xlUp).Row
    DerCol = [IV1].End(xlToLeft).Column
 
    For C = 2 To DerCol
        For L = DerLig To 2 Step -1
            If Cells(L, C) <> "" And Cells(L - 1, C) <> "" Then
                If Cells(L, C) = Cells(L - 1, C) Then Range(Cells(L, C), Cells(L - 1, C)).Merge
            End If
    Next L, C
End Sub

Pour Défusionner

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub Defusionner()
    Application.ScreenUpdating = False
    Sheets("Feuil1").Select
    DerLig = [A10000].End(xlUp).Row
    DerCol = [IV1].End(xlToLeft).Column
    Range("B2").Select
 
    Do While ActiveCell.Row <= DerLig
        Do While ActiveCell.Column <= DerCol
            ZoneSelect = Selection.Address
            NbCell = Range(ZoneSelect).Count
            If NbCell = 1 Then
                ActiveCell.Offset(0, 1).Activate
                GoTo Suite1
            Else
                Libelle = ActiveCell.Value
                Range(ZoneSelect).Select
                With Selection
                    .MergeCells = False
                    .Value = Libelle
                End With
                ActiveCell.Offset(0, NbCell).Activate
                GoTo Suite1
            End If
Suite1:
        Loop
        Cells(ActiveCell.Row + 1, 2).Activate
    Loop
    Range(Cells(2, 2), Cells(DerLig, DerCol)).Borders().Weight = xlThin
End Sub

Avec le fichier en exemple
Pièce jointe 434619

Cdlt

[patricktoulon]

re
bonjour comme ca vite fait pour defusionner les fusion
exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub unmergecellule()
    Dim cel As Range, vv$, add$
    With ActiveSheet.Range("B2", Cells(Rows.Count, "D").End(xlUp))' ADAPTER LA PLAGE ICI!!!!!
        For Each cel In .Cells
            If cel.MergeArea.Cells.Count > 1 Then
                vv = cel.MergeArea.Cells(1).Value: add = cel.MergeArea.Address: cel.MergeArea.MergeCells = False
                cel.Parent.Range(add).Cells.Value = vv
            End If
        Next
    End With
End Sub

c'est plus simple non ?

et pour simplifier la vie pour la fusion et sauter les cellule deja fusionnée se servir de ca aussi

[mika2626]

Super, ca marche ! Merci à vous.