Discussion :

[impur]

Bonjour à tous,

Voici mon soucis:

J'ai un fichier excel avec plusieurs feuilles

Tableau détaillé, tableau 24, tableau 33, etc etc

Je souhaiterais faire une liaison dynamique, par exemple toutes les lignes commencant par 24 dans la colonne A de la feuille "tableau détaillé" dans la feuille "tableau 24".

si j'ai ceci dans tableau détaillé:
24114 A14 B28
24257 B21 H25 G45
24569 J24
33254 J14 K12
33289 K11
33214 F68

je dois avoir ceci dans tableau 24:
24114 A14 B28
24257 B21 H25 G45
24569 J24

et ceci dans tableau 33:
33254 J14 K12
33289 K11
33214 F68

Est ce possible d'obtenir une formule en vba pour faire ce travail?

En vba car la feuille "tableau détaillé" est variable, donc toute modification effectuée sur celle ci doit se faire aussi dans les autres feuilles.

Donc si je rajoute une ligne : 24657 J48 K14 par exemple dans la feuille "tableau détaillé", celle ci dans se mettre aussi automatiquement dans "tableau 24"

Je ne sais pas si je suis clair dans mes propos

je débute en vba mais je fais ceci en ce moment:

Code :

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

Sheets("Tableau détaillé").Range("A1:A11").Copy Sheets("Tableau 24").Range("A1")

donc je copie les plages de cellules, mais si je rajoute une ligne, alors je dois tout décaler car plus rien de correspond, normal!

Je n'arrive pas a rajouter la condition:

copier toutes les lignes commencant par 24 dans "tableau 24", ainsi de suite...

Cordialement

[mercatog]

Bonsoir
Une proposition

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
Option Explicit
 
Sub Dispaching()
Dim asht As Worksheet, sht As Worksheet
Dim Lastlig As Long, i As Long
Dim Kod As String
Dim c As Range
 
Application.ScreenUpdating = False
Set asht = Sheets("Tableau détaillé")
   With asht
      Lastlig = .Cells(Rows.Count, "A").End(xlUp).Row
      For i = 2 To Lastlig
         Kod = Left(.Range("A" & i).Value, 2)
         On Error Resume Next
         Set sht = Sheets("Tableau " & Kod)
         On Error GoTo 0
         If sht Is Nothing Then
            Set sht = Sheets.Add(after:=Sheets(Sheets.Count))
            sht.Name = "Tableau " & Kod
            .Rows(1).Copy sht.Range("A1")
         End If
         Set c = sht.Columns("A:A").Find(.Range("A" & i).Value, LookIn:=xlValues, lookat:=xlWhole)
            If c Is Nothing Then .Rows(i).Copy sht.Cells(Rows.Count, "A").End(xlUp)(2)
         Set c = Nothing
         Set sht = Nothing
      Next i
   End With
asht.Select
Set asht = Nothing
End Sub

[impur]

Bonsoir et merci,

Je viens de tester, cela créer toutes les feuilles des familles, c'est super.

Par contre si je modifie une cellule ou je rajoute une ligne dans tableau détaillé, cela ne se met pas automatiquement dans l'autre feuille adéquate .

Je relance l'execution mais ca ne m'écrase pas les feuilles.

[mercatog]

Comme j'ai compris, le code permet
1. dispatcher les données en autant de feuilles (qui existent, sinon il les crée)
2. si on ajoute des données, tu relance la macro, les nouvelles données se placeront en dernier dans la feuille correspondante.

[impur]

pour le 1) tout est ok.

Pour le 2) :

exemple:

1ere ligne c'est


11001 G21D



si je modifie comme ceci dans tableau détaillé:


11001 G21D H21A


et que je relance la macro, ca ne rajoute pas H21A dans "tableau 11"

par contre si je rajoute une ligne! la ca fonctionne c'est a dire


11001 G21D
11002 A25A


Tableau 11 se met bien a jour dans cette condition

[mercatog]

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
Sub Dispaching()
Dim asht As Worksheet, sht As Worksheet
Dim Lastlig As Long, i As Long
Dim Kod As String
Dim c As Range
 
Application.ScreenUpdating = False
Set asht = Sheets("Tableau détaillé")
   With asht
      Lastlig = .Cells(Rows.Count, "A").End(xlUp).Row
      For i = 2 To Lastlig
         Kod = Left(.Range("A" & i).Value, 2)
         On Error Resume Next
         Set sht = Sheets("Tableau " & Kod)
         On Error GoTo 0
         If sht Is Nothing Then
            Set sht = Sheets.Add(after:=Sheets(Sheets.Count))
            sht.Name = "Tableau " & Kod
            .Rows(1).Copy sht.Range("A1")
         End If
         Set c = sht.Columns("A:A").Find(.Range("A" & i).Value, LookIn:=xlValues, lookat:=xlWhole)
            If c Is Nothing Then
               .Rows(i).Copy sht.Cells(Rows.Count, "A").End(xlUp)(2)
            Else
               .Rows(i).Copy c
            End If
         Set c = Nothing
         Set sht = Nothing
      Next i
   End With
asht.Select
Set asht = Nothing
End Sub