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
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,