transfert d'un tableau sur plusieurs feuilles

Version imprimable

Bonjour,

Je fais appel à vous car je rencontre un petit soucis avec une macro excel 2007 que j'essaye de faire.
Dans un même fichier excel, j'ai une première feuille sur laquelle se trouve un fichier avec des noms de villes dans une première colonne, le matricule, nom et prénom du personnel et leur état. Donc le nom de la ville se répete pour chaque personnel.
Ensuite, toujours dans ce même fichier, j'ai une feuille par nom de ville, je voudrais copier/coller mes données sur le personnel dans la feuille qui lui correspond.
On m'avait deja aidé pour une macro un peu similaire mais la ce n'est pas vraiment la même chose et donc je rame un peu.

Voici le bout de code que j'ai, que je suis en train d'essayer de modifier.
Code:

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 Option Explicit Sub Automatisation() Dim plage As Range Dim trouve As Range Dim nligne As Integer Dim i As Integer Dim feuille As Worksheet Dim nom As String Dim j As Integer Dim a As Integer On Error GoTo suite i = 5 Do Until Cells(i, 1).Value = "" nom = Cells(i, 1).Value Set feuille = Sheets(nom) j = 1 a = 5 'on boucle sur les lignes Do Until a = 5000 'dernière colonne If Cells(i, j).Value = "x" Then feuille.Cells(a, 2).Value = Cells(3, j).Value 'MsgBox (Cells(3, j).Value) a = a + 1 End If a = a + 1 'on passe à la ligne suivante Loop suite: i = i + 1 Loop fin: End Sub
Merci de votre aide

Option Explicit

Code:

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
Sub Automatisation()
 
Dim plage As Range
Dim trouve As Range
Dim nligne As Integer
Dim i As long, DerniereLigne  as long, DerniereLigne2  as long,Dernierecolonne as integer
Dim feuille As Worksheet
Dim nom As String
Dim j As Integer
Dim a As long
 
On Error GoTo suite
DerniereLigne = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row ' récupère le numéro de la dernière ligne
for i = 5 to DerniereLigne  'ca fait plus propre que le do while et loop 
    nom = Cells(i, 1).Value
    Set feuille = Sheets(nom)
    DerniereLigne2 = feuille.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row 
 
    DerniereColonne = Range("IV" & i).End(xlToLeft).Column 'derniere colonne de la ligne en question
 
    for a =5 to DerniereColonne  
            feuille.Cells(DerniereLigne2 +1, a).Value = Cells(i, a).Value
    next a
suite:
if err<>0 then err.clear ' sinon la gestion d'erreur ne fonctionnera qu'une seul fois
next i
 
End Sub

Voila je ne suis pas sur que cela fasse ce que tu veux (cela copie le contenue de la ligne (de la colonne 5 à la dernière de la première feuille a la feuille dons le noms est en cellule colonne A
Et je ne suis pas sur que cela fasse ce que je voulais je n'ai pas testé

21/08/2009, 10h58
cindy6311

Merci de ton aide mais malheureusement le programme ne fait absolument rien. Je n'ai pas non plus de message d'erreur.
21/08/2009, 11h05
Krovax

Doit y avoir une erreur de frappe et la gestion d'erreur le masque. Je vais essayer de corriger cela
21/08/2009, 11h09
cindy6311

Merci beaucoup.
Si je pouvais partir sachant que ca marche ca serait plus que parfait !!
21/08/2009, 11h13
Krovax

Bon alors le programme fonctionne à une condition que tu l'adapte a ton problème ;) (plus un chtit truc il recopie toujours sur la même ligne mais )
N'étant pas a ta place ca je ne peux pas le faire

A mon avis il te suffit dans les formule de dernière ligne de choisir la bonne colonne
les 1 représentent le numéro de la colonne

Code:

DerniereLigne = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row

sinon je pense que tu devrais faire

Code:

feuille.Cells(DerniereLigne2 +1, a-1).Value = Cells(i, a).Value

Car ta première colonne de ta feuille principale est le nom de la ville du coup comme tu ne la recopie pas il faut tout décaler d'un cran

Lance le programme en mode pas a pas (touche F8) et surveille un peu tes variables pour voir comment ca évolue
21/08/2009, 11h31
cindy6311

1 pièce(s) jointe(s)

j'ai compris le problème mais je crois que je ne saurais pas le résoudre :-(

lorsque je lance le programme, il me dit que derniereligne vaut 0 puis . or la boucle for va jusqu'à 5 donc il ne rentre pas dedans et le programme ne s'execute pas.

Normalement, si tout a bien marché, je t'ai mis un extrait du fichier en piece jointe

J'ai oublié une petite précision qui je pense, a son importance...
Ces données sont extraites d'une base et ce fichier est mené à etre modifié tous les jours. C'est pour cela qu'il doit être automatisé.
Merci beaucoup de ton aide !!

Bon alors la seule chose a faire étéait d'adapter la boucle des colonne pour débuter la copie de la 2ème colonne et non la 5ème comme dans la macro que tu avais fournis.
Donc la prochaine fois il est conseillé pour résoudre un problème de vraiment faire l'effort de comprendre le code qui est fournis avant de l'utiliser, si tu ne comprend pas une ligne tu regarde l'aide sur les différent mot clef et si ca ne suffi pas tu demande sur le forum dans la discution. Si tu débute en VBA commence par mettre de coté ton projet regarde les tutos du site il y en a de vraiment très bon et très complet et fait quelque exemple.
Code:

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 Option Explicit Sub Automatisation2() Dim plage As Range Dim trouve As Range Dim nligne As Integer Dim i As Long, DerniereLigne As Long, DerniereLigne2 As Long, Dernierecolonne As Integer Dim feuille As Worksheet Dim nom As String Dim j As Integer Dim a As Long On Error GoTo suite DerniereLigne = Cells(Columns(1).Cells.Count, 1).End(xlUp).Row ' récupère le numéro de la dernière ligne For i = 5 To DerniereLigne 'ca fait plus propre que le do while et loop nom = Cells(i, 1).Value Set feuille = Sheets(nom) DerniereLigne2 = feuille.Cells(Columns(1).Cells.Count, 1).End(xlUp).Row Dernierecolonne = Range("IV" & i).End(xlToLeft).Column 'derniere colonne de la ligne en question For a = 2 To Dernierecolonne feuille.Cells(DerniereLigne2 + 1, a - 1).Value = Cells(i, a).Value Next a suite: If Err <> 0 Then Err.Clear ' sinon la gestion d'erreur ne fonctionnera qu'une seul fois Next i End Sub

21/08/2009, 11h50
cindy6311

Il est vrai que je ne comprend pas tout dans le programme mais ce n'est pas faute de chercher...
Ca ne m'amuse pas spécialement de demander de l'aide aux gens mais ca fait un moment que je suis dessus et je galère vraiment.

Je viens de tester ce que tu m'as envoyé et malheureusement, ca ne fonctionne toujours pas.
Quand je lance le programme pas à pas comme tu me l'as expliqué, la valeur de la dernière ligne vaut 0 puis, quand il rentre dans la boucle for, il dit qu'elle vaut 4 et la il en sort.
La dernière ligne du tableau étant beaucoup plus grande, je ne comprend pas vraiment pourquoi elle vaut 0 et encore moins pourquoi elle vaudrait 4 à la ligne suivante...

Merci
21/08/2009, 11h55
Krovax

Quelle est ta feuille active quand tu lance ta macro?
Il faut que ce soit état du personnel ou alors met la macro dans le code de la feuille
Parce que quand je l'utilise dans ton exemple je n'ai aucun souci

Le deuxième vau 4 car je regarde la dernière ligne de l'onglet de la ville
21/08/2009, 12h00
cindy6311

Effectivement ca avait l'air de venir de ca.
Je pense que je vais mettre un bouton sur ma première page ca sera plus simple...
Par contre, c'est trés long
Est ce que tu connais un moyen de rendre plus rapide ?
Je n'ai aucune formule à aucun moment mais j'ai de la mise en forme conditionnelle. Est ce que ca peut venir de ca ?
En réalité, mon tableau comporte 3 lignes environs.

Merci beaucoup

difficile de faire plus rapide
essaye de mettre

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
sub Automatisation2
 
Dim plage As Range
Dim trouve As Range
Dim nligne As Integer
Dim i As Long, DerniereLigne  As Long, DerniereLigne2  As Long, Dernierecolonne As Integer
Dim feuille As Worksheet
Dim nom As String
Dim j As Integer
Dim a As Long
 
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
 
'le code
 
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
end sub

21/08/2009, 13h35
cindy6311

Merci beaucoup beaucoup pour ton aide...
Cela a pris beaucoup moins de temps donc les quelques lignes de code sont à garder trés précieusement !!
Merci encore