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

[impur]

MERCIIIIIIIIIIIIIIIIII ca fonctionne super là!

merci beaucoup vraiment, ca me facilite la vie à un point pas possible.

Je vais essayer de comprendre le code pour savoir quelle fonction fait quoi...

Cordialement

[mercatog]

Ci joint code avec commentaire pour faciliter la compréhension

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
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                    'permet d'inhiber la mise à kour écran
Set asht = Sheets("Tableau détaillé")                 'asht est la feuille Tableau détaillé
   With asht
      Lastlig = .Cells(Rows.Count, "A").End(xlUp).Row 'dernière ligne remplie de asht
      For i = 2 To Lastlig                            'on parcour de la 2ème ligne jusqu'à la fin
         Kod = Left(.Range("A" & i).Value, 2)         'Kod récuppère les 2 premiers chiffres
         On Error Resume Next                         'gestion d'erreur au cas où une feuille fille n'existe pas
         Set sht = Sheets("Tableau " & Kod)           'on récuppère dans sht la feuille concernée, Rien si elle n'existe pas
         On Error GoTo 0                              'on ferme la gestion d'erreur précédente
         If sht Is Nothing Then                       'si sht est rien
            Set sht = Sheets.Add(after:=Sheets(Sheets.Count))  'on crée une feuille et on la place à la fin
            sht.Name = "Tableau " & Kod                        'on lui attribut le nom adéquat
            .Rows(1).Copy sht.Range("A1")                      'on y copie la ligne des titres
         End If
                                                      'on cherchera l'existance de la valeur complète dans la feuille fille sht
         Set c = sht.Columns("A:A").Find(.Range("A" & i).Value, LookIn:=xlValues, lookat:=xlWhole)
            If c Is Nothing Then                      'si cette valeur n'existe pas
               .Rows(i).Copy sht.Cells(Rows.Count, "A").End(xlUp)(2) 'on l'ajoute dans le première cecclule vide de la colonne A de la feuille fille sht
            Else                                      'si cette  valeur existe
               .Rows(i).Copy c                        'on la remplace
            End If
         Set c = Nothing                              'on libère les variables
         Set sht = Nothing
      Next i
   End With
asht.Select                                           'on re sélevtionne asht (parce que à la création d'une nouvelle feuille, elle devient active
Set asht = Nothing
End Sub