Automatiser une mise en forme

[Sach]

Bonjour à tous !
Novice en vba je viens vous demander de l'aide.
Je cherche à automatiser la création de tableaux à partir d'une liste à classer par ordre alphabétique.

Je reçois tous les jours une liste qui se présente sous la forme 1 que je dois transformer en 2.

Mais je ne vois pas du tout comment m'y prendre... la difficulté (pour moi) étant d'intégrer le tri en fonction du premier mot de la première cellule ( ce sera plus clair dans l'exemple ) .

Merci d'avance.

 

[Gorfael]

Re : Automatiser une mise en forme

Salut Sach et le forum
Macro qui fait les séparations comme dans 2 :

Sub Macro1()
'Déclaration ===========================
Dim X As Long, Y As Integer
'Tri par la première colonne ===========
Columns("A:C").Sort Key1:=Range("A1"), Order1:=xlAscending
'Boucle de séparation ==================
For X = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
    If Y = 0 Then Y = InStr(Cells(X, "A"), " ")
    Cells(X, "A").Select
    If Left(Cells(X, "A"), Y) <> Left(Cells(X - 1, "A"), Y) Then
        Rows(X).Insert Shift:=xlDown
        Cells(X, "A") = "NOM"
        Cells(X, "B") = "URL1"
        Cells(X, "C") = "URL2"
        Range(Cells(X, "A"), Cells(X, "C")).HorizontalAlignment = xlCenter
        Rows(X).Insert Shift:=xlDown
        Rows(X).Insert Shift:=xlDown
        Y = 0
    End If
Next X
Rows(X).Insert Shift:=xlDown
Cells(X, "A") = "NOM"
Cells(X, "B") = "URL1"
Cells(X, "C") = "URL2"
Range(Cells(X, "A"), Cells(X, "C")).HorizontalAlignment = xlCenter
End Sub

Par contre l'encadrement est fait par un objet, mais je ne sais pas lequel (et pas envie de chercher vu l'heure)
A+

 

[Sach]

Re : Automatiser une mise en forme

Merci beaucoup ! ça marche très bien et ça va vraiment me faire gagner du temps !

Il me reste plus qu'a essayer d'automatiser la création des tableaux. J'ai essayé mais la principale difficulté pour moi est de ne pas sélectionner les lignes vides pour faire les tableaux séparés. Pour le moment soit tout devient un tableau (avec UsedRange) soit seul le premier groupe...

 

[Gorfael]

Re : Automatiser une mise en forme

Salut Sach et le forum
Regardes comment se comporte la sélection en sélectionnant Nom et <Ctrl>+<flèche vers le bas>
Ce qui correspond à Range("A" & 1).End(XlDown)
A+

 

[Sach]

Re : Automatiser une mise en forme

Bonjour

Après avoir cherché j'ai trouvé ce code qui me permet de sauter les lignes vides mais je n'arrive pas a créer le tableau, je peux utiliser une propriété mais avec un objet je coince...

Sub Macro1()
Dim ConstantCells As Range
Dim FormulaCells As Range
Dim cell As Range
On Error Resume Next
Set ConstantCells = Selection _
.SpecialCells(xlConstants)
For Each cell In ConstantCells
If cell.Value > 0 Then
cell.Interior.Color = vbRed
End If
Next cell
Set FormulaCells = Selection _
.SpecialCells(xlFormulas)
For Each cell In FormulaCells
If cell.Value > 0 Then
cell.Interior.Color = vbRed
End If
Next cell
End Sub

 

[Gorfael]

Re : Automatiser une mise en forme

Salut Sach et le forum
La macro corrigée :

Sub Macro1()
'Déclaration ===========================
Dim X As Long, Y As Integer, Z As Integer
Dim Plage As Range
'Tri par la première colonne ===========
Columns("A:C").Sort Key1:=Range("A1"), Order1:=xlAscending
'Boucle de séparation ==================
For X = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
    If Y = 0 Then Y = InStr(Cells(X, "A"), " ")
    Cells(X, "A").Select
    If Left(Cells(X, "A"), Y) <> Left(Cells(X - 1, "A"), Y) Then
        Rows(X).Insert Shift:=xlDown
        Cells(X, "A") = "NOM"
        Cells(X, "B") = "URL1"
        Cells(X, "C") = "URL2"
        Range(Cells(X, "A"), Cells(X, "C")).HorizontalAlignment = xlCenter
        Rows(X).Insert Shift:=xlDown
        Rows(X).Insert Shift:=xlDown
        Y = 0
    End If
Next X
Rows(X).Insert Shift:=xlDown
Cells(X, "A") = "NOM"
Cells(X, "B") = "URL1"
Cells(X, "C") = "URL2"
Range(Cells(X, "A"), Cells(X, "C")).HorizontalAlignment = xlCenter
'Crétion des listes  ====================
For X = 1 To Range("A" & Rows.Count).Row
    If Range("A" & X) <> "" Then
        Y = X
        X = Range("A" & X).End(xlDown).Row
        Z = Z + 1
        Set Plage = Range(Range("A" & Y), Range("C" & X))
        ActiveSheet.ListObjects.Add(xlSrcRange, Plage, , xlYes).Name = "Liste_" & Z
        X = X + 1
    End If
Next X
End Sub

N'utilisant jamais les listes, je n'étais pas sûr de la nature de l'objet.
A+

 

[Sach]

Re : Automatiser une mise en forme

Merci beaucoup pour cette formule ! Je peux enfin faire autre chose de mes journées

encore merci !