réunir plusieurs feuilles contenant chacune un tableau

[juju1994]

Bonjour,
J'ai dans un classeur contenant 10 feuilles qui représentent 10 sociétés différentes. A l'intérieur de chaque feuille il y a un tableau qui regroupe les employés qui travaille dans cette société avec différentes informations (famille, nom, fixe, mobile, société). Est-il possible de réunir ces 10 tableaux dans une unique feuille? je ne veux pas réunir les 10 tableaux en un seul, juste qu'il soit les uns à coté des autres pour que une fois tous réunis, je puisse imprimer cette feuille. De meme il faudrait que si je modifie, ajoute, ou supprime un employé dans une société, le changement se fasse dans la feuille finale.
Je suppose qu'il faut faire une macro mais je ne vois pas comment faire.
Merci de votre aide.

 

[vgendron]

Re : réunir plusieurs feuilles contenant chacune un tableau

Bonjour,

Regarde la PJ pour exemple:
cela utilise la fonction indirect et les fonctions Ligne() et colonne()
reste plus qu'à adapter à ton projet

 

[juju1994]

Re : réunir plusieurs feuilles contenant chacune un tableau

merci de ton aide.

 

[juju1994]

Re : réunir plusieurs feuilles contenant chacune un tableau

bonjour,
J'ai oublié de préciser un détail, les tableaux je vais les réunir dans 2 feuilles : une feuille avec que les fixe et une deuxième avec que les mobiles, comment fait-on parce que les fixes et les mobiles sont parfois mélangés?
Merci

 

[vgendron]

Re : réunir plusieurs feuilles contenant chacune un tableau

Bonjour,

Regarde cet autre topic: post 5: le fichier test
vous avez peut etre le meme besoin: des tableaux sur plusieurs onglets à mettre dans le meme..
après tu parles de fixe..mobile.... ???

 

[juju1994]

Re : réunir plusieurs feuilles contenant chacune un tableau

merci de ta réponse
Quand je parle de fixe ou mobile c'est telephone fixe et telephone mobile

 

[juju1994]

Re : réunir plusieurs feuilles contenant chacune un tableau

je trouve pas post 5, il est ou?
merci

 

[vgendron]

Re : réunir plusieurs feuilles contenant chacune un tableau

bon. on va faire plus clair: pas de fichier exemple, pas d'aide.........

 

[juju1994]

Re : réunir plusieurs feuilles contenant chacune un tableau

voila le fichier exemple.
Feuil1 = tableau brut mélangé pour les société
Fixe = tableau ou il doit y avoir que les fixes
mobile = tableau ou il doit avoir que les mobiles
ABC = employés de la société ABC
AZE = employés de la société AZE
ZER = employés de la société ZER*

J'ai une macro dans module qui fait permet le tri des employés dans Feuil1 et les ajoutes dans le tableau correspondant a leurs société

 

[vgendron]

Re : réunir plusieurs feuilles contenant chacune un tableau

ouh laa. vite. retire ce fichier..tu vas te faire gronder
il faut juste un fichier exemple sans aucune donnée confidentielle. la tu nous mets un accès direct à une liste officielle de nom, société et numéro de tel..

met un fichier avec juste deux ou trois lignes et des noms et numéro bidon

 

[vgendron]

Re : réunir plusieurs feuilles contenant chacune un tableau

bon sinon, vu que j'ai eu le temps de regarder:
je vois que tu as déjà tous les éléments pour faire ce que tu souhaites
si j'ai bien compris: tu veux ventiler la feuill1 dans les onglets Fixe et mobile tout comme tu l'as déjà fait pour les onglets de société.

il te suffit donc juste de recopier la dernière boucle de ton code et la modifier pour les onglets fixe et mobile
à rajouter en fin de macro. juste avant le end sub

'boucle de transfert dans Fixe ou mobile
For x = 1 To derniereligne - 1
    'comparaison du nom de la société avec le nom de la feuille
    onglet = Replace(plage(x, 1), 1, -1, vbTextCompare)
    'derniere cellule non vide colonne A de l'onglet en cours
    dernierelignecolonne = Worksheets(onglet).Range("A" & Rows.Count).End(xlUp).Row + 1
    'copie infos
    Range(plage(x, 1), plage(x, 5)).Copy Worksheets(onglet).Range("A" & dernierelignecolonne)
Next x

Note: il faut que tu rajouttes un onglet "Convergent". sinon, tel quel. ca plante

 

[juju1994]

Re : réunir plusieurs feuilles contenant chacune un tableau

merci de ta réponse pendant que je modifier le message j'ai pas vu ce que tu avais mis. Le problème c'est qu'il faut pas d'onglet convergent

 

[vgendron]

Re : réunir plusieurs feuilles contenant chacune un tableau

Dans ce cas,
il suffit de rajoutter un test sur le nom de l'onglet

'boucle de transfert dans Fixe ou mobile
For x = 1 To derniereligne - 1
    'comparaison du nom de la société avec le nom de la feuille
    onglet = Replace(plage(x, 1), 1, -1, vbTextCompare)
    If onglet <> "Convergent" Then
        'derniere cellule non vide colonne A de l'onglet en cours
        dernierelignecolonne = Worksheets(onglet).Range("A" & Rows.Count).End(xlUp).Row + 1
        'copie infos
        Range(plage(x, 1), plage(x, 5)).Copy Worksheets(onglet).Range("A" & dernierelignecolonne)
    End If
Next x

 

[juju1994]

Re : réunir plusieurs feuilles contenant chacune un tableau

ca marche pour les fixe et mobile mais les convergent apparaissent nul part. Il faudrait que leur fixe apparaissent dans l'onglet fixe et que leur mobile apparaissent dans l'onglet mobile.

 

[vgendron]

Re : réunir plusieurs feuilles contenant chacune un tableau

ha. et donc. avec ceci?
j'allais justement te dire que dans le cas ou il y a deux numéros de tel, il y a allait avoir un manque.. ;-)

Sub lstentreprise()
 Dim derniereligne As Long 'ligne
 Dim dernierelignecolonne As Integer 'colonne
 Dim feuille As Worksheet
 Dim plage As Range
 
'remise à zero des infos dans tous les onglets
For Each feuille In Worksheets
    'test si onglet société
    If feuille.Name <> "Feuil1" Then
        'remise à zero cellules
        Worksheets(feuille.Name).Cells.ClearContents
        'copie des titres colonnes
        Worksheets("feuil1").Range("A1:E1").Copy Worksheets(feuille.Name).Range("A1")
    End If
Next feuille

'derniere cellule non vide colonne A de feuil1

derniereligne = Worksheets("feuil1").Range("A" & Rows.Count).End(xlUp).Row
'mise en memoire des infos
Set plage = Worksheets("feuil1").Range("A2:E" & derniereligne)
'boucle de transfert infos dans onglets
For x = 1 To derniereligne - 1
    'comparaison du nom de la société avec le nom de la feuille
    onglet = Replace(plage(x, 5), 1, -1, vbTextCompare)
    'derniere cellule non vide colonne A de l'onglet en cours
    dernierelignecolonne = Worksheets(onglet).Range("A" & Rows.Count).End(xlUp).Row + 1
    'copie infos
    Range(plage(x, 1), plage(x, 5)).Copy Worksheets(onglet).Range("A" & dernierelignecolonne)
Next x
 
'boucle de transfert dans Fixe ou mobile
For x = 1 To derniereligne - 1
    'comparaison du nom de la société avec le nom de la feuille
    onglet = Replace(plage(x, 1), 1, -1, vbTextCompare)
    If onglet <> "Convergent" Then
        'derniere cellule non vide colonne A de l'onglet en cours
        dernierelignecolonne = Worksheets(onglet).Range("A" & Rows.Count).End(xlUp).Row + 1
        'copie infos
        Range(plage(x, 1), plage(x, 5)).Copy Worksheets(onglet).Range("A" & dernierelignecolonne)
    End If
    If onglet = "Convergent" Then
        'si le convergent a un numéro de fixe
        If (plage(x, 3) <> "") Then
            onglet = "Fixe" 'on va recopier le convergent dans l'onglet fixe
            'derniere cellule non vide colonne A de l'onglet en cours
            dernierelignecolonne = Worksheets(onglet).Range("A" & Rows.Count).End(xlUp).Row + 1
            'copie infos
            Range(plage(x, 1), plage(x, 5)).Copy Worksheets(onglet).Range("A" & dernierelignecolonne)
            'puis on efface le numéro de mobile qui a été copié inutilement
            Worksheets(onglet).Range("D" & dernierelignecolonne).ClearContents
        End If
        
        If plage(x, 4) <> "" Then
            onglet = "Mobile" 'on va recopier le convergent dans l'onglet Mobile
            'derniere cellule non vide colonne A de l'onglet en cours
            dernierelignecolonne = Worksheets(onglet).Range("A" & Rows.Count).End(xlUp).Row + 1
            'copie infos
            Range(plage(x, 1), plage(x, 5)).Copy Worksheets(onglet).Range("A" & dernierelignecolonne)
            'puis on efface le numéro de fixe qui a été copié inutilement
            Worksheets(onglet).Range("C" & dernierelignecolonne).ClearContents
        End If
    End If
Next x
End Sub