excel lien entre classeur vba

Version imprimable

14/01/2017, 11h37
KENT74700

excel lien entre classeur vba

Bonjour,
J'ai une centaines de fichier excel, tous identiques (au niveau du format) que je veux synthétiser dans un seul fichier excel de RECAP
Ces fichiers sont tous nommé de la façon suivante
101.xlsx
103.xlsx
.....
198.xlsx
201.xlsx
203.xlsx
Sur chacun de ces fichiers je souhaite seulement récupérer la ligne 5 de la feuille 2.

Dans le fichier RECAP, j'ai la colonne B nommée "fichier source"
(C'est là ou ça se complique....) Je voudrais que lorsque je tape le nom d'un fichier source, dans la colonne B, par exemple 198, la ligne 5 de la feuille 2 du fichier 198, s'affiche à la suite, à partir de la colonne C dans RECAP

Voila j'espère que j'ai été clair, merci d'avance pour votre aide.

Bonjour,

attention, je n'ai pas testé le code suivant ! un peu d'indulgence s'il ne fonctionne pas comme prévu !

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
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim oCell As Range
  Dim oClassAct As Workbook
  Dim oClassSource As Workbook
  Set oClassAct = ActiveWorkbook
  For Each oCell In Target
    If oCell.Column = 2 Then
      On Error Resume Next
      Err.Clear
      Workbooks.Open ActiveWorkbook.Path & "\" & oCell & ".xls", False, False
      If Err.Number <> 0 Then
        MsgBox "Fichier non trouvé ! etc...."
        On Error GoTo 0
        Exit Sub
      End If
      Set oClassSource = ActiveWorkbook
      Worksheets(2).Activate
      Range("A5:Z5").Copy
      oClassAct.Activate
      oCell.Offset(0, 1).PasteSpecial xlPasteAll
      oClassSource.Close False
    End If
  Next
End Sub

reste plus qu'à nous dire si ça roule !

14/01/2017, 14h02
KENT74700

D'accord je vois un peu l'idée, par contre je débute vraiment en VBA... donc serait il possible d'avoir un peu plus de détail sur ce code.

Merci
14/01/2017, 14h47
EBRAG

ce code est à installer dans la partie privée de ta feuille récap

Dans la fenêtre VBA Project, double-clic sur le nom de ta feuille récap qui doit recevoir l'info et balance le code.

Pour ce qui est du détail plus explicite du code, pas trop le temps là tout de suite... mais tu peux aller consulter les sites des différents contributeurs de ce forum, en cliquant sur leur nom et suivre le lien site Web (Mon nom à moi, c'est EBRAG !:ptdr:)

Bonne chance, et fais-nous le retour pour savoir si c'est OK !

D'accord moi je mettais dans un module....

Sinon, là j'en suis au stade ou lorsque je rentre le numéro de fichier par exemple 108 dans une ligne de la colonne B, j'ai la message box qui s'affiche "fichier introuvable"...
C'est justement là, où je comprend pas trop le code:
Code:

1 2 3 4 5 6 7 8 9 If oCell.Column = 2 Then On Error Resume Next Err.Clear Workbooks.Open ActiveWorkbook.Path & "\" & oCell & ".xls", False, False If Err.Number <> 0 Then MsgBox "Fichier non trouvé ! etc...." On Error GoTo 0 Exit Sub End If
Mon fichier 108.xlsx doit-il être ouvert et doit-il, lui, prendre en compte les macros?

Merci d'avance.

14/01/2017, 16h34
EBRAG

le message dit "fichier introuvable" ou "Fichier non trouvé ! etc...." ?

ce qui n'est pas du tout la même chose !

le fichier 108.xls est-il dans le même dossier que Recap ? si c'est un xlsx, il faut remplacer xls par xlsx bien entendu dans le code !
14/01/2017, 22h34
KENT74700

Le message est bien ""Fichier non trouvé !" c'est ce que j'ai mis dan le code

Et ou j'ai bien mis xlsx dans le code, comme mon fichier, ils sont également dans même dossier.

J'ai avancé un peu, actuellement, lorsque je tape le nom du fichier 108 par exemple, j'ai l'impression que le code me copie/colle la ligne 5 de mon fichier récap, au lieu d'aller chercher la ligne 5 de la feuille 2 du fichier 108
14/01/2017, 23h12
eriiic

Bonjour,

Fait en pas en pas (un Stop en début de macro puis F8) pour contrôler si c'est bien la bonne feuille du bon classeur qui est active au moment du Copy.
A-priori ça devrait mais bon, tu dis la Feuille 2 c'est vague. EBRAG a traduit en Sheets(2) qui est la 2nde feuille affichée, qui peut être Feuil5...
Sinon utilise son nom : Sheets("Feuil2")
Et corrige le Range, tu voulais à partir de la colonne C
eric
25/01/2017, 19h12
KENT74700

Je n'arrive pas à faire du pas à pas pour débuguer car j'ai l'impression que ce n'est pas vraiment une macro, ERBAG, m'a dit de coller sont code dans Feuil(1) de VBA et ce n'est pas dans un module.
Et si je mets le code dans un module, ça ne fonctionne pas du tout.
25/01/2017, 19h23
joe.levrai

Bonjour,

cette procédure est dite "évènementielle", c'est à dire qu'elle va se lancer toute seule, comme une grande, quand l'évènement se produit

ici, l'évènement se déclenche quand, au sein de la feuille qui possède la procédure, la valeur d'une cellule est modifiée. Cette cellule est le paramètre Target

cela n'empêche pas de faire du pas à pas, avec deux méthodes :

- celle déjà indiquée : écrire STOP juste avant la ligne de code où tu veux commencer ton pas à pas
==> quand tu vas modifier une cellule, ta procédure va s'arrêter à l'instruction STOP et souligner le mot en jaune. De là, chaque appuie sur la touche F8 fera exécuter la ligne de code suivante

- quand tu es dans le fenêtre qui affiche ta procédure, met ton curseur sur la ligne où tu veux commencer le pas à pas. Clic-droit >> Basculer >> Point d'arrêt. La ligne devient marron et tu viens de placer un "STOP" implicite à partir de cette ligne
==> il est possible de réaliser cette même opération en cliquant dans le "bord gris" situé à gauche de la zone où on écrit le code

Ok oui ça marche bien la méthode pas à pas, du coups je confirme que toute la partie en gras ci-dessous fonctionne parfaitement, mais après il ne veux pas copier les cellule du fichier qui s'est ouvert......

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
For Each oCell In Target
    If oCell.Column = 2 Then
        On Error Resume Next
        Err.Clear
        Workbooks.Open ActiveWorkbook.Path & "\" & oCell & ".xlsx", False, False
                 If Err.Number <> 0 Then
                     MsgBox "Fichier non trouvé!"
                     On Error GoTo 0
                      Exit Sub
                 End If
        Set oClassSource = ActiveWorkbook
        Worksheets(Feuil2).Activate
       Range("C5:J5").Copy
       ' oClassAct.Activate
        'oCell.Offset(0, 1).PasteSpecial xlPasteAll
        'oClassSource.Close False'
    End If
Next

Personnellement, je proscris dès que c'est possible (soit 99% du temps) l'utilisation des objets "actifs" (activecell, activeworkbook, activesheet etc...)

voici une proposition écrite à la volée, j'ai inséré moultes variables pour ta compréhension, mais elle ne sont pas nécessaires (sauf Wb)

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Wb As Workbook                  ' le classeur qu'on va chercher à ouvrir
Dim CheminDossier As String         ' le chemin qui mène au dossier où sont les fichiers à ouvrir
Const SEP As String = "\"           ' le séparateur
Const EXTENSION As String = ".xlsx" ' l'extension des fichiers
' si les fichiers à ouvrir ne sont pas dans le dossier du classeur RECAP, il faut changer cette variable
CheminDossier = ThisWorkbook.Path
 
    ' on ne travaille que sur la colonne 2
    ' et uniquement si on a modifié une seule cellule
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Column <> 2 Then Exit Sub
 
    On Error Resume Next
        ' on tente d'ouvrir le classeur (en lecture seule, sans mise à jour des liens)
        Set Wb = Workbooks.Open(CheminDossier & SEP & Target.Value & EXTENSION, False, True)
    On Error GoTo 0
 
    ' si la tentative d'ouverture a échoué
    If Wb Is Nothing Then
        MsgBox "Le fichier " & Target.Value & " n'a pas été trouvé dans le dossier " & CheminDossier
        Exit Sub
    End If
 
    With Wb
        ' changer le nom de la feuille si c'est pas ça
        ' changer également la plage si c'est pas A5:Z5
        ' on copie la zone à partir de la cellule située à droite du nom de fichier du classeur RECAP
        .Worksheets("Feuil2").Range("A5:Z5").Copy Target.Offset(0, 1)
        ' fermer le classeur sans l'enregistrer
        .Close False
    End With
End Sub

25/01/2017, 20h19
KENT74700

Roooo, ça marche du tonnerre, merci bien !!

Pour rendre le code plus propre, on peut tester si le fichier existe via la fonction Dir()
Si ça renvoie une chaine vide : le fichier n'existe pas

Ca évite de sauvagement provoquer et gérer une erreur... et au passage de rendre la variable Wb non obligatoire

EDIT : refait à la volée, voici avec Dir()

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub Worksheet_Change(ByVal Target As Range)
Dim CheminDossier As String, CheminFichier As String
Const SEP As String = "\"
Const EXTENSION As String = ".xlsx"
    With Target
        If .Cells.Count > 1 Or .Column <> 2 Then Exit Sub
        CheminDossier = ThisWorkbook.Path
        CheminFichier = CheminDossier & SEP & .Value & EXTENSION
        If Dir(CheminFichier) = "" Then MsgBox "Le fichier " & .Value & " n'a pas été trouvé dans le dossier " & CheminDossier: Exit Sub
    End With
    With Workbooks.Open(CheminFichier, False, True)
        .Worksheets("Feuil2").Range("A5:Z5").Copy Target.Offset(0, 1)
        .Close False
    End With
End Sub