Compléter code VBA

Bonsoir,

Je souhaite utiliser un code VBA pour fusionner les cellules de certaines colonnes, avec des lignes nouvellement créées (en fonction d'un chiffre renseigné dans le tableau).

La partie création de ligne est terminée, en revanche, j'ai encore du mal avec la fusion des cellules.

Actuellement, mes cellules se fusionnent comme souhaité, en revanche, je n'arrive pas à demander à ce que cette fusion s'effectue sur plusieurs colonnes. Ainsi, j'ai actuellement, uniquement les cellules de la colonne A qui se fusionnent, j'aimerai qu'il se passage la même chose pour les colonnes B, C, D, E, et I, et J.

Voici le code :

Private Sub Fusion()

Dim t As Long
Dim myLastRow As Long
myLastRow = Cells(Rows.Count, "A") & Cells(Rows.Count, "B") & Cells(Rows.Count, "C").End(xlUp).Row

Application.DisplayAlerts = False
    For t = myLastRow - 1 To 3 Step -1
        If Cells(t + 1, 1) = "" Then
            Range(Cells(t, 1), Cells(t + 1, 1)).Merge
        End If
    Next t
Application.DisplayAlerts = True

End Sub

Une idée ?

Cette partie : & Cells(Rows.Count, "B") & Cells(Rows.Count, "C") ne fonctionne pas.

Merci.

Bonne soirée !

La Drosophile

bonsoir Le Drosophile

par contre cette partie fonctionne très bien

je pense que tu cherche ça:

Ah oui, il faut que je répète la ligne en indiquant les coordonnées de la colonne.

Je teste et je reviens !

A priori ça fonctionne, mais une fois utilisé sur mon document de travail, ça utilise toutes les ressources de mon ordinateur (pourtant pas mauvais) et ça ne donne jamais de résultat...

Private Sub Fusion()

Dim t As Long
Dim LastR As Long
LastR = Cells(Rows.Count, "A").End(xlUp).Row

Application.DisplayAlerts = False
    For t = LastR - 1 To 3 Step -1
        If Cells(t + 1, 1) = "" Then
            Range(Cells(t, 1), Cells(t + 1, 1)).Merge
            Range(Cells(t, 2), Cells(t + 1, 2)).Merge
            Range(Cells(t, 3), Cells(t + 1, 3)).Merge
            Range(Cells(t, 4), Cells(t + 1, 4)).Merge
            Range(Cells(t, 5), Cells(t + 1, 5)).Merge
            Range(Cells(t, 10), Cells(t + 1, 10)).Merge
            Range(Cells(t, 11), Cells(t + 1, 11)).Merge
            Range(Cells(t, 12), Cells(t + 1, 12)).Merge
            Range(Cells(t, 13), Cells(t + 1, 13)).Merge
        End If
    Next t
Application.DisplayAlerts = True

End Sub

EDIT :

Ça me fusionne 340 lignes inutiles et ça m'inscrit "11" dans 180224 cellules... Il reste des trucs à voir...

Bonjour Le Drosophile, AMIR, le forum,

J'ai tester ton code, il semble fonctionner correctement (sur excel 2010),

Si j'ai bien compris, de la colonne 1 à la colonne 13 (donc de A à M), si cellule colonne A (à partir de A4)remplie et cellules suivantes colonne A vides, on fusionne les lignes de A à M ?

Sub Fusion()

Dim t As Long, i As Integer
Dim LastR As Long
LastR = Cells(Rows.Count, "A").End(xlUp).Row

Application.DisplayAlerts = False
Application.ScreenUpdating = False
    For t = LastR - 1 To 3 Step -1
     For i = 1 To 13
        If Cells(t + 1, 1) = "" Then
            Range(Cells(t, i), Cells(t + 1, i)).Merge
        End If
     Next i
    Next t
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Cordialement,

Salut,

Merci pour ta réponse ! Et merci beaucoup pour les modifications !!

Si j'ai bien compris, de la colonne 1 à la colonne 13 (donc de A à M), si cellule colonne A (à partir de A4)remplie et cellules suivantes colonne A vides, on fusionne les lignes de A à M ?

Oui c'est ça, sauf qu'il s'agit en réalité des colonnes A à E puis J à M.

Ça marche en effet ; les bugs que j'avait provenaient de cellules qui étaient restées dans mon document test, Excel a essayé de les traiter... Avec un tableau propre le code fonctionne très bien, il faut juste que les colonnes F à I ne soient pas traitées.

Du coup j'ai mis à jour comme suit :

Dim t As Long, i As Integer, k As Integer
Dim LastR As Long
LastR = Cells(Rows.Count, "A").End(xlUp).Row

Application.DisplayAlerts = False
Application.ScreenUpdating = False
    For t = LastR - 1 To 3 Step -1
     For i = 1 To 5
        If Cells(t + 1, 1) = "" Then
            Range(Cells(t, i), Cells(t + 1, i)).Merge
        End If
     Next i
     For k = 10 To 13
        If Cells(t + 1, 1) = "" Then
            Range(Cells(t, k), Cells(t + 1, k)).Merge
        End If
     Next k
    Next t
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Bonne journée !

Re,

 il faut juste que les colonnes F à I ne soient pas traitées

A tester:

Sub Fusion()

Dim t As Long, i As Integer, j As Integer
Dim LastR As Long
LastR = Cells(Rows.Count, "A").End(xlUp).Row

Application.DisplayAlerts = False
Application.ScreenUpdating = False
    For t = LastR - 1 To 3 Step -1
     For i = 1 To 5
      For j = 10 To 13
        If Cells(t + 1, 1) = "" Then
            Range(Cells(t, i), Cells(t + 1, i)).Merge
            Range(Cells(t, j), Cells(t + 1, j)).Merge
        End If
      Next j
     Next i
    Next t
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Cordialement,

Ah bah merci, les deux modifications fonctionnent.

Par contre, dernier souci, ma dernière ligne ne fusionne pas avec les lignes en dessous (si elle le faisait, elle fusionnerait avec des milliers de lignes inutiles)... Il faudrait néanmoins qu'elle fusionne avec le nombre de ligne équivalent au chiffre inscrit en cellule M1.

(C'est à partir de cette même cellule que j'indique le nombre de lignes à créer puis à fusionner).

Re,

Peut-être ainsi .....

Sub Fusion()

Dim t As Long, i As Integer, j As Integer, x As Integer
Dim LastR As Long
LastR = Cells(Rows.Count, "A").End(xlUp).Row
x = Cells(LastR, 13).Value
Application.DisplayAlerts = False
Application.ScreenUpdating = False
    For t = LastR - 1 To 3 Step -1
     For i = 1 To 5
      For j = 10 To 13
        If Cells(t + 1, 1) = "" Then
            Range(Cells(t, i), Cells(t + 1, i)).Merge
            Range(Cells(t, j), Cells(t + 1, j)).Merge
            Range(Cells(LastR, i), Cells(LastR + x, i)).Merge
            Range(Cells(LastR, j), Cells(LastR + x, j)).Merge
        End If
      Next j
     Next i
    Next t
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Cordialement,

Merci !

J'ai indiqué :

x = Cells(1, 13).Value

pour désigner la cellule M1 et désormais, avec vos améliorations, tout fonctionne parfaitement.

Bon après-midi !

Cool

Bonne soirée,