[XL-2007] Envoyer des données d'un fichier excel vers un autre fichier

[Langelusyfaire]

Bonjour,

Tout d'abord je tiens à préciser que je suis nouveau sur le forum et veuillez m'excuser si je ne fais pas encore choses dans les formes.

Voici mon problème : J'ai 2 fichiers xl, le premier ( XL1 ) est un fichier vierge que j'envoie à divers personnes il contient des information du type : numéro de dossier ; nom de la voiture; puissance; couleur.

Le deuxième fichier est un fichier récepteur d'information: constitué des même catégories numéro de dossier ; nom de la voiture; puissance; couleur. Ce fichier va compliler l'ensemble des informations des fichiers XL1 selon le numéro de dossier.

Tant que j'ai 1 fichier XL 1 tout va bien je me débrouille avec les fonctions INDEX et EQUIV mais vu que j'ouvre plusieur fois le fichier XL1 numéro 1 XL1 numéro 2 ect... là tout part en vrille et je n'ai les données que d'un seul fichier XL1 (numéro 1 par exemple)

J'aimerais savoir comment faire pour rajouter un bouton/icone à cliquer sur chaque fichier XL1 pour envoyer les données sur le fichier XL2 et mettre les information à la bonne place.
Je pense que je vais avoir besoin du VBA et surtout de vous !

Je vous joint un fichier explicatif

Merci de toute l'aide que vous pourrez m'apporter

[Daniel.C]

Bonjour,

En supposant que toutes les feuilles s'appellent "Feuil1" et que les cellules "Numéro de dossier" soient en A1, attache la macro suivante à un commandbutton sur la feuille "Feuil1" de Xl2. La macro demande d'ouvrir l'un après l'autre les classeurs Xl1. Cliquer sur le bouton "Annuler" de la fenêtre d'ouverture de fichier :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub CommandButton1_Click()
    Dim Fich As String, Ligne As Long, Sh As Worksheet
    Set Sh = ThisWorkbook.Sheets("Feuil1")
    Do
        Fich = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
        If Fich = "Faux" Then Exit Sub
        Workbooks.Open Fich
        With Sheets("Feuil1")
            Ligne = Sh.Cells(Sh.Rows.Count).End(xlUp).Row + 2
            Sh.Cells(Ligne, 1) = .[A3]
            Sh.Cells(Ligne, 2) = .[B3]
            Sh.Cells(Ligne, 3) = .[C3]
            Sh.Cells(Ligne, 4) = .[D3]
        End With
        ActiveWorkbook.Close False
    Loop
End Sub

[Langelusyfaire]

Bonjour,

Merci de ta réponse rapide !!

j'ai essayé de tester le code que tu m'as passer il me semble que c'est se que je souhaite. Mais je suis plus que novice dans le vba donc je galère un peu.

J'ai trouvé un code pour créer un bouton que j'ai mis avec ton code:

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
Sub CréerBouton()
 
Dim Obj As Object
Dim Code As String
 
Sheets("Feuil1").Select
 
'crée le bouton
    Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
    Link:=False, DisplayAsIcon:=False, Left:=200, Top:=100, Width:=100, Height:=35)
    Obj.Name = "BoutonTest"
'texte du bouton
    ActiveSheet.OLEObjects(1).Object.Caption = "Tester le bouton"
 
'Le texte de la macro
    Code = "Sub BoutonTest_Click()" & vbCrLf
    Code = Code & "Call Tester" & vbCrLf
    Code = Code & "End Sub"
'Ajoute la macro en fin de module feuille
    With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
        .insertlines .CountOfLines + 1, Code
    End With
End Sub
 
Private Sub CommandButton1_Click()
    Dim Fich As String, Ligne As Long, Sh As Worksheet
    Set Sh = ThisWorkbook.Sheets("Feuil1")
    Do
        Fich = Application.GetOpenFilename("Excel Files (*classeur2.xls*), *classeur2.xls*")
        If Fich = "Faux" Then Exit Sub
        Workbooks.Open Fich
        With Sheets("Feuil1")
            Ligne = Sh.Cells(Sh.Rows.Count).End(xlUp).Row + 2
            Sh.Cells(Ligne, 1) = .[A3]
            Sh.Cells(Ligne, 2) = .[B3]
            Sh.Cells(Ligne, 3) = .[C3]
            Sh.Cells(Ligne, 4) = .[D3]
        End With
        ActiveWorkbook.Close False
    Loop
End Sub

Ca ne marche pas trop donc je pense avoir fait une erreur ^^"
je pense que j'ai besoin d'acheter un livre sur les cours de VBA !
Si tu peux m'aider merci d'avance

[Daniel.C]

La création de ton bouton fonctionne. Dans la foulée, tu crées une macro BoutonTest_Click qui fait appel à une autre macro : Tester. Il faut que tu changes le nom de la macro :

Code :

Private Sub CommandButton1_Click()

et que tu le remplaces par :

Code :

Sub Tester()

[White Mibu]

Bonjour,

regarde le fichier joint, ici je fais l'opération dans l'onglet feuil1 pour l'exemple mais c'est simple à adapter pour le faire entre différents classeurs Excel.

Tiens moi au courant si c'est ce que tu cherche... !

Cordialement

[Langelusyfaire]

Merci White Mibu c'est exactement ce que je souhaite !!!
Je vais essayer d'adapter ce que tu as fait à ce que je souhaite obtenir !
Si j'ai des problèmes je reposte

Encore Merci !!

[White Mibu]

Ok n'hésite pas si tu rencontre des problèmes ! Je suis pas allé dans le détail parce qu'il me manqué certains détails, notamment si tu veux sélectionner le fichier cible en question ou à l'inverse si il est fixe, enfin bref tiens nous au courant

Cordialement

[Langelusyfaire]

Je suis désolé de mon ignorance mais...
ON PEUT ? ? ? ? ?
J'ai bien réussi à faire se que je souhaitais en cliquant sur le bouton et que les données aillent sur le fichier souhaité et à la place souhaitée !
Par contre je me suis posé une question : Et si on déplace le fichier cible ou si on change le nom du dossier ect... Donc si tu me dis que l'on peut cibler le fichier cible ça peut être pas mal.

[White Mibu]

Bonjour,

Oui on peut !

Deux solutions :
- Tu as plusieurs fichiers qui sont organisés de la même façon ?

Code :

Cible = Application.GetOpenFilename("Excel Files (*.xls), *.xls")

Ici il te suffit d'adapter .xls(version 97-2003), .xlsx(version 2010), .xlsm(version 2010 avec macro) ou autre...
Donc avec ça tu va ouvrir directement le fichier en question, il faut mettre ça lors de l'ouverture du fichier de ta macro.

- Deuxième solution, ton fichier change de place mais pas régulièrement ?

Dim Chemin1 As String, Cible1 As String
Chemin1 = Sheets("Feuil1").Cells(1, 1).Value
Fichier1 = Sheets("Feuil1").Cells(2, 1).Value

Workbooks.Open (Chemin1 & "\" & Fichier1)

Ici le chemin est pris directement sur l'onglet de ton classeur source, à toi d'adapter l'endroit prècis.

J'imagine que dans ton cas la première solution est la bonne. Dit moi si cela te convient...

(Il est possible également de choisir ton fichier sans l'ouvrir et de récupérer le chemin et le nom du fichier dans des variables pour après manipuler ton fichier comme tu veux, mais je pense que tu as seulement besoin d'ouvrir ton fichier...)

J'ai pris la première solution comme exemple, voir fichier joint. A toi d'adapter la macro, tiens moi au courant si tu rencontre un problème.

Cordialement

[Langelusyfaire]

Je m'en retourne vers vous un peu dépité...

Voilà j'ai terminé l'ensemble des fichiers pour lesquels je souhaitais utiliser le VBA.
Après avoir testé avec succès le code VBA sur des fichiers test j'ai adapté les macros sur mes vrais fichiers...

Et là ... c'est le drame !!

Je me retrouve avec une... ***** d'erreur d'exécution 1004 ou Erreur 400
Je ne comprend absolument pas pourquoi.

Je vous remet la macro en espérant qu'un personne avisé puisse m'aider.
Malheureusement soumis à la confidentialité je ne peux pas transmettre les fichiers.

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 Test()
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    Dim i As Variant, j As Variant
    Dim Chemin As String, NomFichier As String
    i = Workbooks("Tableau").Worksheets("feuil1").Cells(6, 11).Value
 
    'Ici tu peut mettre une boite de dialogue ou autre pour ouvrir le classeur Excel cible
    Workbooks.Open "C:\Users\arnaud\TEST excel\test\Suivi.xlsm"
 
    Workbooks("Suivi").Worksheets("Tableau de suivi").Range("A2").Select 'A adapter selon où se trouve le nom des dossier dans l'autre fichier
    Do While ActiveCell.Value <> i
    ActiveCell.Offset(1, 0).Select
    Loop
 
    j = ActiveCell.Row
 
    'Cas avec plusieurs classeurs il faudra ici spécifier le classeur et l'onglet
    Workbooks("Suivi").Worksheets("Tableau de suivi").Cells(j, 3) = Workbooks("Tableau").Worksheets("feuil1").Cells(17, 2).Value
    Workbooks("Suivi").Worksheets("Tableau de suivi").Cells(j, 4) = Workbooks("Tableau").Worksheets("feuil1").Cells(23, 2).Value
    Workbooks("Suivi").Worksheets("Tableau de suivi").Cells(j, 5) = Workbooks("Tableau").Worksheets("feuil1").Cells(29, 2).Value
 
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
 
End Sub

Ps : En utilisant la lecture pas à pas je me rends compte que celà bloque à l'étape : " Workbooks("Suivi").Worksheets("Tableau de suivi").Range("A2").Select 'A adapter selon où se trouve le nom des dossier dans l'autre fichier " juste avant le Do While

[White Mibu]

Bonjour,

essai ça :

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
Sub Test ()
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    Dim i As Variant, j As Variant
    Dim Cible As String, Source As String
    i = Workbooks("Tableau").Worksheets("Feuil1").Cells(6, 11).Value
    Source = ActiveWorkbook.Name
 
    Cible = Application.GetOpenFilename("Excel Files (*.xlsm), *.xlsm")
    If Cible = "" Then Exit Sub
 
    Workbooks.Open Cible
    Cible = ActiveWorkbook.Name
 
    Range("A2").Select 'A adapter selon où se trouve le nom des dossier dans l'autre fichier
    Do While ActiveCell.Value <> i
    ActiveCell.Offset(1, 0).Select
    Loop
 
    j = ActiveCell.Row
 
    'Cas avec plusieurs classeurs il faudra ici spécifier le classeur et l'onglet
    Cells(j, 3) = Workbooks("Tableau").Worksheets("Feuil1").Cells(17, 2).Value
    Cells(j, 4) = Workbooks("Tableau").Worksheets("Feuil1").Cells(23, 2).Value
    Cells(j, 5) = Workbooks("Tableau").Worksheets("Feuil1").Cells(29, 2).Value
 
    Workbooks(Cible).Save
    Workbooks(Cible).Close
 
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
 
End Sub

Moi ça marche...(j'ai rajouter la boite de dialogue pour sélectionner ton fichier)

Cordialement

[Langelusyfaire]

Tu es génial !!!!

Cepndant j'aurai une autre requette je te le demande directement ça m'évitera de revenir dans 3 jours en pleurant

Tout marche bien mais il y a un hic !

Si le fichier "Suivi" est ouvert et si des éléments ont été rentré sans être sauvegardés alors la macro ferme violament le pauvre fichier sélectionné et on perd toutes les données.

Y aurait-il la possibilité de rajouté dans la macro un élément du type :

Code :

1
2
3
4
5
6
7
8
9
10
11
 
Sub Test ()
If FichierEstOuvert("C:\Users\arnaud\TEST excel\test\Suivi.xlsm") 
Then
Goto next
   Else
    Cible = Application.GetOpenFilename("Excel Files (*.xlsm), *.xlsm")
    If Cible = "" Then Exit Sub
 
    Workbooks.Open Cible
    Cible = ActiveWorkbook.Name

Est possible ?
En gros si le fichier est déjà ouvert alors passer à la suite de la macro "next" au copier coller des cellules sinon aller chercher le fichier et continuer la suite normale de la macro.

En tout cas merci de ton aide, qui est à la fois rapide et aussi efficasse !

Cordialement

[White Mibu]

Je sais pas si j'ai saisi exactement...

Tu veux que si le fichier est déjà utilisé il te propose de sélectionner un autre fichier ? Parce que logiquement, tu ne veux pas continuer la macro si il est utilisé car il ne doit pas s'ouvrir...

Essai ça mais je te garanti rien :

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
47
48
49
50
51
52
Sub Test ()
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    Dim i As Variant, j As Variant
    Dim Cible As String, Source As String, NomCible As String
    i = Workbooks("Tableau").Worksheets("Feuil1").Cells(6, 11).Value
    Source = ActiveWorkbook.Name
 
GestionErreur:
 
    Cible = Application.GetOpenFilename("Excel Files (*.xlsm), *.xlsm")
    MsgBox (Cible)
    If Cible = False Then Exit Sub
 
    On Error Resume Next
    Workbooks.Open (Cible), ReadOnly:=True
    NomCible = ActiveWorkbook.Name
 
    If Err.Number <> 0 Then
    Workbooks(NomCible).Close SaveChanges = False
    MsgBox ("Fichier utilisé !")
    On Error GoTo 0
    GoTo GestionErreur
    End If
 
    If Err.Number = 0 Then
    Workbooks(NomCible).Close SaveChanges = False
    Workbooks.Open (Cible)
 
    Range("A2").Select 'A adapter selon où se trouve le nom des dossier dans l'autre fichier
    Do While ActiveCell.Value <> i
    ActiveCell.Offset(1, 0).Select
    Loop
 
    j = ActiveCell.Row
 
    'Cas avec plusieurs classeurs il faudra ici spécifier le classeur et l'onglet
    Cells(j, 3) = Workbooks("Tableau").Worksheets("Feuil1").Cells(17, 2).Value
    Cells(j, 4) = Workbooks("Tableau").Worksheets("Feuil1").Cells(23, 2).Value
    Cells(j, 5) = Workbooks("Tableau").Worksheets("Feuil1").Cells(29, 2).Value
 
    Workbooks(NomCible).Save
    Workbooks(NomCible).Close
 
    End If
 
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
 
End Sub

Enfaite si cela ne marche pas c'est qu'il n'y a pas d'erreur lorsqu'on ouvre un fichier déjà en lecture seule... je peux pas tester !

Je t'explique un peu le principe, tu ouvre le fichier en question en lecture seule pour ne pas supprimer les modifications apportées.
- Si il y a erreur on ferme sans enregistré (lecture seule) et on revient à la sélection d'un autres fichier.
- Si il n'y a pas d'erreur on peut continuer la macro !

Seulement si il n'y a pas d'erreur lors de l'ouverture d'un fichier déjà utilisé... la macro continuera quand même...

C'est une proposition, je pense qu'il y a d'autres solutions ! Mais tu peux essayer ça, ça peut marcher... Sinon tiens moi au courant...

Cordialement

[Langelusyfaire]

Bonsoir,

Non c'est pas exactement se que je souhaite.

je te refait la procédure : j'ouvre le fichier avec le bouton je le remplie.
Je clique sur le bouton là normalement une boite de message souvre pour aller chercher le fichier que tu veux en l'occurence le fichier "suivi" ! C'est parfait !
Mais le petit plus serait de rajouter un truc qui fait que si je clique et que le fichier "suivi" est déjà ouvert alors je zape l'étape de : "la boite de message pour aller rechercher le fichier "suivi" ".
Et ensuite dans les deux cas je continue la macro avec les copier coller !

Tu crois que c'est possible ? En tout cas merci c'est déjà géniale se que j'ai !

[White Mibu]

Bonjour,

oui je pense que c'est tout à fait possible

Enfaite il était question d'un fichier ouvert sur ton propre ordinateur... dsl je travaille beaucoup sur des données importer en réseau donc j'étais parti sur une mauvaise piste !

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
Sub Test()
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    Dim i As Variant, j As Variant
    Dim Cible As String, Source As String
    i = Workbooks("Tableau").Worksheets("Feuil1").Cells(6, 11).Value
    Source = ActiveWorkbook.Name
 
    On Error Resume Next
    Workbooks("Suivi").Activate
 
    If Err.Number > 0 Then
        Cible = Application.GetOpenFilename("Excel Files (*.xlsm), *.xlsm")
        If Cible = False Then Exit Sub
        Workbooks.Open Cible
        On Error GoTo 0
    End If
 
    Cible = ActiveWorkbook.Name
 
    Range("A2").Select
    Do While ActiveCell.Value <> i
    ActiveCell.Offset(1, 0).Select
    Loop
 
    j = ActiveCell.Row
 
    Cells(j, 2) = Workbooks("Tableau").Worksheets("feuil1").Cells(17, 2).Value
    Cells(j, 3) = Workbooks("Tableau").Worksheets("feuil1").Cells(23, 2).Value
    Cells(j, 4) = Workbooks("Tableau").Worksheets("feuil1").Cells(29, 2).Value
 
    Workbooks(Cible).Save
    Workbooks(Cible).Close 'Supprimer cette ligne si tu veux que le fichier reste ouvert
 
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
 
End Sub

Essaye ça et tiens moi au courant ! (vers la fin si tu veux que le fichier reste ouvert supprime la ligne avec le commentaire)

Cordialement

[Langelusyfaire]

GENIAL !!!!!!!

C'est parfait !!! j'aimerais savoir un truc par contre. Je ne comprend pas le :

If Err.Number > 0 Then

et

On Error GoTo 0

A quoi correspond le 0 ?

De plus je viens de me rendre compte d'un truc si je lance l'enregistrement et qu'il ne trouve pas l'équivalent du :

i = Workbooks("Tableau").Worksheets("Feuil1").Cells(6, 11).Value

la macro se met à tourner en boucle pour faire toutes les cellules et soit j'attend 5 min soit je ferme méchament excel !

On ne peut pas le limiter ? Mon tableau ne fait que 200 lignes ça serait balo qu'il cherche dans les 65536 lignes si au bout de 200 ça ne sert plus à rien de chercher.

On ne peut rien faire avec le

ActiveCell.Offset(1, 0).Select

pour lui dire d'aller de 1 à 200 ?

Merci encore à mon avis ça sera la dernière demande !

[White Mibu]

If Err.Number > 0 Then

Enfaite si excel repère une erreur : Err.Number sera égal à 70 par exemple.
Donc ici Err.Number supérieur à 0 ça équivaux à il y a une erreur !

On Error GoTo 0

Dans le cas où excel a repéré une erreur, on vient ensuite supprimer le fait que excel ai repéré une erreur. On obtient après ça Err.Number = 0 (Aucune erreur).

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
Sub Test()
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    Dim i As Variant, j As Variant
    Dim Cible As String, Source As String
    i = Workbooks("Tableau").Worksheets("Feuil1").Cells(6, 11).Value
    Source = ActiveWorkbook.Name
 
    On Error Resume Next
    Workbooks("Suivi").Activate
 
    If Err.Number > 0 Then
        On Error GoTo 0
        Cible = Application.GetOpenFilename("Excel Files (*.xlsm), *.xlsm")
        If Cible = "Faux" Then Exit Sub
        Workbooks.Open Cible
    End If
 
    Cible = ActiveWorkbook.Name
 
    Range("A2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value = i Then j = ActiveCell.Row
        ActiveCell.Offset(1, 0).Select
    Loop
 
    'Bloc à adapter :
    If j = "" Then
        MsgBox ("Numéro dossier introuvable !")
        Workbooks(Cible).Close
        Exit Sub
    End If
 
    Cells(j, 2) = Workbooks("Tableau").Worksheets("Feuil1").Cells(17, 2).Value
    Cells(j, 3) = Workbooks("Tableau").Worksheets("Feuil1").Cells(23, 2).Value
    Cells(j, 4) = Workbooks("Tableau").Worksheets("Feuil1").Cells(29, 2).Value
 
    Workbooks(Cible).Save
    Workbooks(Cible).Close 'Ligne à adapter
 
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
 
End Sub

Voilà reste à voir ce que tu veux faire si le numéro de dossier est introuvable MsgBox ou non ? Enfin bref tu verra bien, tiens moi au courant si ça te va...

Cordialement

[Langelusyfaire]

Je ne vois pas en quoi la dernière macro bloque la recherche à 200 lignes et non 65596 si il y a pas la valeur recherchée dans les 200 cellules

Et merci pour les explications j'ai tout compris

[White Mibu]

Code :

1
2
3
4
5
    Range("A2").Select
    Do While ActiveCell.Value <> ""
        If ActiveCell.Value = i Then j = ActiveCell.Row
        ActiveCell.Offset(1, 0).Select
    Loop

La différence est qu'ici la boucle while s'arrête jusqu'à ce qu'elle atteigne une cellule vide, alors qu'avant jusqu'à ce qu'elle tombe sur le bon numéro de dossier... donc avec ça le nombre de ligne du tableau peut évoluer !

J'aime pas fixer les choses, mais si tu veux les fixer à 200 rien de plus simple :

Code :

1
2
3
4
5
    Range("A2").Select
    Do While ActiveCell.Value <> i
        If ActiveCell.Row > 200 Then Exit Sub
        ActiveCell.Offset(1, 0).Select
    Loop

Cordialement

[Langelusyfaire]

YEAAaa !!!!

ça marche nikel mais malheureusement pour toi j'ai fixer les cellules à 200 et non les cellules vides : je t'explique pourquoi il peux arriver que je soit obligé de sauter une ligne pour y revenir après et dans ce cas là, la recherche s'arréterait.

Autre problème apparue...
Le fichier "Tableau" est un fichier source qui va être renommé imédiatement après son ouverture (pour des raisons pratique de sauvegarde de données si il arrive quoi que se soit).
Du coup j'ai une erreur d'application à cause du :

i = Workbooks("Tableau").Worksheets("Feuil1").Cells(6, 11).Value

j'ai vu qu'il y avait :

Source = ActiveWorkbook.Name

juste en dessous.
Normalement si je ne m'abuse quand on clique sur le bouton qui se trouve sur le fichier "tableau" en feuille1 la feuille activé est Workbooks("tableau") et la feuille est worksheets("Feuil1"). Du coup on ne pourrait pas mettre ActiveWorksheets.Cells(6,11).Value ? J'ai test et ça ne marche pas .. ça serait trop simple on dirait. Tu peux encore m'aider ?

Merci beaucoup !