Discussion :

[EstebanBueno]

Bonjour à tous,

Je suis nouveau sur le forum, jusqu'ici j'essaie toujours de trouver mes réponses sur les sujets déjà traités, mais là ça ne fonctionne pas.

Je suis débutant en VBA, je précise, donc désolé d'avance si mon code vous pique les yeux;..

Donc voilà, ma macro pour le moment convertit un fichier .csv en .xlsm, elle me créé trois feuilles où les données sont triés en fonction d'une de leur caractéristiques.

Mon problème maintenant est qu'il faut que je trie chacune de mes feuilles.

En gros, il y a un identifiant et un nom pour chaque entité, et c'est comme ça que je les différencie car c'est un identifiant + un nom par ligne. Néanmoins, il existe dans mon fichier des groupes, qui fait que sur une même ligne, il y a plusieurs identifiants et noms.

Ma macro donc, cherche dans la première ligne le "Marque 2" qui représente le second identifiant.
On connait donc la colonne dans laquelle il peut y avoir des groupes avec plusieurs identifiants. Je regarde donc si chacune des cellules de cette colonne est vide, si elle ne l'est pas, alors c'est donc un groupe avec plusieurs identifiants, je copie donc la ligne, je l'insers en dessous, et je coupe l'identifiant et le nom pour les coller là ou il y a le premier identifiant et le premier nom.

Tout ça pour dire que ça ne fonctionne pas, si quelqu'un à une idée pour la faire fonctionner, je vous remercie

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
Sub duplication()
 
Dim nb_lignes_tableau As Integer
    Dim col_marque2 As String
    Dim i As Integer
    Dim j As Integer
    Sheets("Base Auto").Select
    'on cherche le numéro de colonne du texte marque 2
    For i = 1 To 50 '50 est un chiffre aléatoire, sachant que mon tableau est forcément plus petit
    If Cells(1, i).Value Like "Marque 2" Then
    col_marque2 = i
    End If
    Next
 
    nb_lignes_tableau = Application.WorksheetFunction.CountA(Range("A1:A" & Range("A65536").End(xlUp).Row))  ' calcul du nb de lignes du tableau
 
    For j = 2 To nb_lignes_tableau 'on part de la seconde ligne car la première est remplie des entêtes (marque 2 par exemple)
    If Cells(ii, col_marque2).Value <> "" Then
    Rows(ii).Copy ' on copie toute la ligne de la cellule non vide de la colonne marque 2
    Selection.Insert Shift:=xlDown 'on insère la même ligne en dessous
    Range(Cells(ii, col_marque2), Cells(ii, col_marque2 + 1)).Cut Destination:=Cells(ii, col_marque - 2)
        'maintenant qu'on a dupliqué la ligne, on coupe la cellule non vide et celle à sa droite, qu'on colle deux cellules à gauche
    End If
 
Next j
End Sub

[Patrice740]

Bonjour,

Remplaces ii par j ou inversement !

[EstebanBueno]

Oui pardon, j'avais changé le nom de la variable pour le poster sur le forum et je l'avais pas changé partout.

Cela me pose problème car les données copiées et collées ne sont pas de la même taille j'ai l'impression.

Code :

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

Selection.Insert Shift:=xlDown 'on insère la même ligne en dessous

[EstebanBueno]

J'ai réussi à ne plus avoir d'erreur comme celles évoquées, mais le problème c'est que ça me copie colle une centaine de fois la ligne de la première cellule non vide, et la macro s'arrête sans s'occuper des futures cellules non vides..

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
Dim nb_lignes_tableau As Integer
    Dim col_marque2 As Variant
    Dim ii As Integer
    Dim jj As Integer
    Sheets("Base Auto").Select
    'on cherche le numéro de colonne du texte marque 2
    For ii = 1 To 50 '50 est un chiffre aléatoire, sachant que mon tableau est forcément plus petit
    If Cells(1, ii).Value Like "Raison Sociale 2" Then
    col_marque2 = ii
    End If
    Next
 
    nb_lignes_tableau = Application.WorksheetFunction.CountA(Range("A1:A" & Range("A65536").End(xlUp).Row))  ' calcul du nb de lignes du tableau
 
    For jj = 2 To nb_lignes_tableau 'on part de la seconde ligne car la première est remplie des entêtes (marque 2 par exemple)
    If Cells(jj, col_marque2).Value <> "" Then
    Rows(jj).Copy ' on copie toute la ligne de la cellule non vide de la colonne marque 2
    Rows(jj).Select
    Selection.Insert Shift:=xlDown 'on insère la même ligne en dessous
    Range(Cells(jj, col_marque2), Cells(jj, col_marque2 + 1)).Cut Destination:=Cells(jj, col_marque2 - 2)
        'maintenant qu'on a dupliqué la ligne, on coupe la cellule non vide et celle à sa droite, qu'on colle deux cellules à gauche
    End If
 
Next jj

[Patrice740]

Bonjour,

Je suis pas sur d'avoir compris ce que tu veux faire !

Essaies :

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
31
32
Option Explicit
Sub duplication()
Dim P As Range    'Plage de cellules
Dim C As Range    'Cellule
Dim T As String   'Titre
Dim F As String   'Feuille
Dim D As Long     'Dernière ligne
Dim L As Long     'Ligne
  F = "Base Auto"
  T = "Raison Sociale 2"
  'Chercher le titre
  Set P = Worksheets(F).Rows(1)
  Set C = P.Find(what:=T, LookIn:=xlValues, lookat:=xlWhole)
  If C Is Nothing Then
    P.Parent.Activate
    MsgBox "Il n'y a pas de colonne « " & T & " » dans " & F, vbCritical
    Exit Sub
  End If
  Set P = C.EntireColumn
  With Worksheets(F)
    D = .Cells(.Rows.Count, "A").End(xlUp).Row
    For L = D To 2 Step -1
      If P.Cells(L, 1).Value <> "" Then
        'Dupliquer la ligne
        .Rows(L).Insert shift:=xlDown
        .Rows(L + 1).Copy Destination:=.Rows(L)
        'Déplacer les 2 cellules vers la gauche
        P.Cells(L + 1, 1).Resize(1, 2).Cut Destination:=P.Cells(L + 1, 1).Offset(0, -2)
      End If
    Next L
  End With
End Sub

[EstebanBueno]

Bonjour Patrice,

Oui ça fonctionne, merci beaucoup !

En revanche, je dois faire cette opération sur plusieurs "Raison Sociale", à savoir "Raison Sociale 3" "Raison Sociale 4" etc, qui se trouve à un autre endroit dans la première ligne. Ton code permet de chercher à chaque fois en changeant le T = et le Offset suivant de combien je voulais que cela se décale.

Néanmoins quand je répète ton code je ne retrouve pas mes petits (il y a eu trop de lignes de dupliquées). J'ai essayé, me disant que c'était parce que le nom des variables restait le même, alors j'ai essayé de faire plusieurs macros distinctes que j'ai ensuite appelé dans la macro source ("Call duplication1" par exemple). Dois-je répéter le code en créant de nouvelles variables à chaque fois ?

Exemple :

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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
 
Sub duplication()
Dim P As Range    'Plage de cellules
Dim C As Range    'Cellule
Dim T As String   'Titre
Dim F As String   'Feuille
Dim D As Long     'Dernière ligne
Dim L As Long     'Ligne
  F = "Base Auto"
  T = "Raison Sociale 6"
  'Chercher le titre
  Set P = Worksheets(F).Rows(1)
  Set C = P.Find(what:=T, LookIn:=xlValues, lookat:=xlWhole)
  If C Is Nothing Then
    P.Parent.Activate
    MsgBox "Il n'y a pas de colonne « " & T & " » dans " & F, vbCritical
    Exit Sub
  End If
  Set P = C.EntireColumn
  With Worksheets(F)
    D = .Cells(.Rows.Count, "A").End(xlUp).Row
    For L = D To 2 Step -1
      If P.Cells(L, 1).Value <> "" Then
        'Dupliquer la ligne
        .Rows(L).Insert shift:=xlDown
        .Rows(L + 1).Copy Destination:=.Rows(L)
        'Déplacer les 2 cellules vers la gauche
        P.Cells(L + 1, 1).Resize(1, 2).Cut Destination:=P.Cells(L + 1, 1).Offset(0, -10)
      End If
    Next L
  End With
 
T = "Raison Sociale 5"
  'Chercher le titre
  Set P = Worksheets(F).Rows(1)
  Set C = P.Find(what:=T, LookIn:=xlValues, lookat:=xlWhole)
  If C Is Nothing Then
    P.Parent.Activate
    MsgBox "Il n'y a pas de colonne « " & T & " » dans " & F, vbCritical
    Exit Sub
  End If
  Set P = C.EntireColumn
  With Worksheets(F)
    D = .Cells(.Rows.Count, "A").End(xlUp).Row
    For L = D To 2 Step -1
      If P.Cells(L, 1).Value <> "" Then
        'Dupliquer la ligne
        .Rows(L).Insert shift:=xlDown
        .Rows(L + 1).Copy Destination:=.Rows(L)
        'Déplacer les 2 cellules vers la gauche
        P.Cells(L + 1, 1).Resize(1, 2).Cut Destination:=P.Cells(L + 1, 1).Offset(0, -8)
      End If
    Next L
  End With
End Sub

Si tu peux m'éclairer, si ce n'est pas clair je comprendrai, merci beaucoup en tout cas