Discussion :

[piloupilou82]

Bonjour,

je n'ai pas réussi à trouver d'aide pour créer une macro m'évitant 150 copier/coller de données d'un tableau vers 150 onglets différents .... donc je sollicite votre aide, merci !

J'ai donc un tableau de 15000 lignes, avec des colonnes allant de A à L.
Sur la colonne E, j'ai un numéro.
Je souhaite extraire toutes les lignes correspondant à un même numéro dans la colonne E vers un onglet portant le nom de ce numéro, et ceci pour tous les différents numéros de cette colonne E, vers autant d'onglets distincts.

J'ai réussi à créer avec un début de macro, les onglets portant comme nom les numéros.

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 CreationOnglet()
   ActiveCell.CurrentRegion.Select
   Dim Tableau() As String
   ReDim Tableau(1 To ActiveCell.CurrentRegion.Count)
 
   For Ctr = 1 To ActiveCell.CurrentRegion.Count
     Tableau(Ctr) = ActiveCell.CurrentRegion(Ctr)
   Next
 
   For Ctr = 1 To ActiveCell.CurrentRegion.Count
     Sheets.Add , Sheets(Sheets.Count)
     Sheets(Sheets.Count).Name = Tableau(Ctr)
   Next
 
End Sub

Pourriez-vous m'aider à la compléter pour réaliser le copier/coller des lignes du tableau initial correspondant à chaque numéro vers l'onglet correspondant ? (j'ai mis un exemple en Pièce Jointe). Idéalement, il faudrait aussi recopier la première ligne d'entête du tableau de la feuil1 dans chaque onglet.

Un grand merci pour votre aide !

[casefayere]

Bonsoir,
Je ne suis pas sur d'avoir tout compris, mais essayes ce code, qui réinitialise les feuilles et reprend les données

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
Sub CreationOnglet()
Dim Tbl, x As Long, Dl As Long, y As Long, z As Long
Dim Ws As Worksheet
With Sheets("Feuil1")
  Dl = .Range("E" & .Rows.Count).End(xlUp).Row
  Tbl = .Range("A1:L" & Dl)
End With
For Each Ws In Worksheets
  z = 1
  For x = 1 To UBound(Tbl, 1)
    With Ws
      If .Name = Tbl(x, 5) Then
        Dl = .Range("E" & .Rows.Count).End(xlUp).Row
        .Range("A1:L" & Dl).ClearContents
        For y = 1 To 12
          .Cells(1, y) = Tbl(1, y)
        Next y
        z = z + 1
        For y = 1 To 12
          .Cells(z, y) = Tbl(z, y)
        Next y
      End If
    End With
  Next x
Next Ws
 
End Sub

[piloupilou82]

Bonjour,
merci beaucoup. J'ai essayé, mais ça ne colle qu'une seule ligne dans chaque onglet alors qu'il y a généralement plusieurs lignes concernées par ce même numéro.
Curieusement ça colle la ligne dans le nouvel onglet en bas du tableau et non à la suite de la ligne d'en tête.

Merci pour vos conseils !

[casefayere]

Re,
Avec le fichier que tu as envoyé, je n'ai eu aucun problème, d'autant plus que je provoque avant

Code :

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

.Range("A1:L" & Dl).ClearContents

et tout se recopie normalement, as-tu testé sur un autre fichier ? si oui essayes déjà avec ton fichier exemple.

[piloupilou82]

re,
j'ai bien testé avec mon fichier exemple, et c'est bizarre car il n'y a qu'une seule ligne copiée dans chaque onglet, et ça ne correspond pas toujours au bon numéro ! je ne comprends pas ...
voici ce que j'obtiens en pièce jointe ...

[casefayere]

essayes comme ça :

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
Sub CreationOnglet()
Dim Tbl, x As Long, Dl As Long, y As Long, z As Long
Dim Ws As Worksheet
With Sheets("Feuil1")
  Dl = .Range("E" & .Rows.Count).End(xlUp).Row
  Tbl = .Range("A1:L" & Dl)
End With
For Each Ws In Worksheets
  z = 1
  For x = 1 To UBound(Tbl, 1)
    With Ws
      If .Name = Tbl(x, 5) Then
        If z = 1 Then
          Dl = .Range("E" & .Rows.Count).End(xlUp).Row
          .Range("A1:L" & Dl).ClearContents
        End If
        For y = 1 To 12
          .Cells(1, y) = Tbl(1, y)
        Next y
        z = z + 1
        For y = 1 To 12
          .Cells(z, y) = Tbl(z, y)
        Next y
      End If
    End With
  Next x
Next Ws
 
End Sub

[piloupilou82]

merci, mais ça ne marche pas complètement : ça marche bien pour le 1er numéro, puis pour le 2ème onglet ça copie les lignes du 1er numéro puis du 2ème numéro, puis après le tri par numéro ne fonctionne plus ... voilà les résultats en pj.
il faudrait peut être ajouter dans le code qu'on efface les lignes du tableau initial au fur et à mesure qu'on les a copiés dans un nouvel onglet ?

[casefayere]

il faudrait peut être ajouter dans le code qu'on efface les lignes du tableau initial au fur et à mesure qu'on les a copiés dans un nouvel onglet ?

Pour l'instant, je ne me suis pas occupé de créer des onglets.

Comme je ne connais pas ton but final, si tu effaces les lignes du tableau initial, tu ne les retrouveras plus et comme on vide tes autres onglets, le résultat sera toujours complêtement remanié mais c'est peut-être ce que tu cherches. Tu n'envoies que des "xlsx" donc je ne peux pas voir tes macros, envoies donc soit en zip ou une copie en "xls".

[piloupilou82]

ah d'accord :-)
voilà la PJ.
Je sais créer les onglets automatiquement, donc c'est bon de ce côté là. Par contre mon but est bien d'avoir toutes les lignes correspondant au même numéro dans un onglet, toutes les lignes correspondant à un deuxième numéro dans un deuxième onglet etc.

[casefayere]

Je n'ai pas encore regardé ton dernier fichier mais j'ai fait une erreur ici

Code :

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

1
2
3
For y = 1 To 12
          .Cells(z, y) = Tbl(x, y)
        Next y

, essaies ce code

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
Sub CreationOnglet()
Dim Tbl, x As Long, Dl As Long, y As Long, z As Long
Dim Ws As Worksheet
With Sheets("Feuil1")
  Dl = .Range("E" & .Rows.Count).End(xlUp).Row
  Tbl = .Range("A1:L" & Dl)
End With
For Each Ws In Worksheets
  z = 1
  For x = 1 To UBound(Tbl, 1)
    With Ws
      If Trim(.Name) = Trim(Tbl(x, 5)) Then
        If z = 1 Then
          Dl = .Range("E" & .Rows.Count).End(xlUp).Row
          .Range("A1:L" & Dl).ClearContents
        End If
        For y = 1 To 12
          .Cells(1, y) = Tbl(1, y)
        Next y
        z = z + 1
        For y = 1 To 12
          .Cells(z, y) = Tbl(x, y)
        Next y
      End If
    End With
  Next x
Next Ws
 
End Sub

[Marc-L]

Bonjour.

Dominique, copier des cellules filtrées serait plus simple & plus rapide, non ?

[piloupilou82]

un grand merci Dominique, ça marche !!! super !

[casefayere]

Bonsoir,
A piloupilou82

un grand merci Dominique, ça marche !!! super !

Content pour toi, bonne soirée,

A Marc

Dominique, copier des cellules filtrées serait plus simple & plus rapide, non ?

Tu as certainement raison mais pourquoi faire simple quand on peut faire compliqué
Bonne soirée également, Marc