Discussion :

[alhousseini]

Bonjour,

Je dois repartir des données de plusieurs entreprises d'une feuille dans des onglets differents :un onglet par entreprise.Il est possible de le faire à la main mais cela prend trop de temps.

Si quelqu'un à une macro à adapter je suis preneur.

[casefayere]

Bonjour,
Dans quelles cellules saisis-tu tes entreprises ?
Quel est le nom de la feuille principale dont les données sont à répartir ?
Dans quelles cellules sont les données à repartir ?

[alhousseini]

Peu importe le nom de la feuille(classeur1), je pourrais le changer.
les cellules :cellules(2,1), cellules(2,2),
contiennent le numero et le nom de l'entreprise.

[alhousseini]

Toujours à la recherche d'une solution à mon probleme.J'ai ce code qui ne s'excute pas si j'ai plus de 254 Lignes dans ma feuille excel.Il marche très bien si il y a moins de 255 lignes.

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
Sub transfert()
Dim L As Byte, Item
Dim Col_Services As Collection
Dim Tabtemp As Variant
Dim TabService() As Variant
Dim Ws_Tableau As Worksheet, ws As Worksheet
Dim Derlgn As Byte, C As Byte
Set Ws_Tableau = Worksheets("Feuil1")
Set Col_Services = New Collection
Application.ScreenUpdating = False
With Ws_Tableau
  For Each ws In Worksheets
  Application.DisplayAlerts = False
  If ws.Name <> "Feuil1" Then ws.Delete
  Application.DisplayAlerts = False
  Next
  Tabtemp = .Range("A1:D" & .Range("A900").End(xlUp).Row).Value
  On Error Resume Next
 For L = 2 To UBound(Tabtemp, 1)
    Col_Services.Add Tabtemp(L, 1), CStr(Tabtemp(L, 1))
 Next
 On Error GoTo 0
 Err.Clear
End With
For Item = 1 To Col_Services.Count
 
Worksheets.Add.Name = Col_Services(Item)
With Worksheets(Col_Services(Item))
        .Move after:=Sheets(Sheets.Count)
        .Cells(1, 1) = Tabtemp(1, 1)
        .Cells(1, 2) = Tabtemp(1, 2)
        .Cells(1, 3) = Tabtemp(1, 3)
        .Cells(1, 4) = Tabtemp(1, 4)
 
  For L = 2 To UBound(Tabtemp, 1)
    If Tabtemp(L, 1) = Col_Services(Item) Then
     Derlgn = .Range("A900").End(xlUp).Row + 1
     For C = 1 To UBound(Tabtemp, 2)
       .Cells(Derlgn, C) = Tabtemp(L, C)
     Next
 
    End If
   Next
End With
Next
Application.ScreenUpdating = False
End Sub

[dodo69]

Es-tu sur qu'il est possible de créer un nombre d'onglet supérieur a 256?
Ca doit etre sur les capacité d'Excel que ca bloque plutot que sur le code

[alhousseini]

Merci dodo69.
C'est pas les onglets . En y ajoutant des lignes qui nimpliquent pas la creation des nouveaux onglets ..Il bloque