Discussion :

[mikadoo57]

Bonjour,
je suis en train de rechercher la façon d'importer des feuilles d'autres fichiers vers un fichier de synthèse.
Pour l'instant je travaille sur une maquette très simple : au sein d'un même dossier, 2 fichiers appelés "metz" et "toul", chacun comportant 3 feuilles dont la première porte le nom du fichier (metz ou toul), les autres feuilles sont vides pour l'instant. j'ai créé un troisième fichier appelé "synthèse" dans lequel je veux importer la feuille 1 de mes 2 autres fichiers.
j'ai adapté le code suivant :

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
Sub consolide()
  ChDir ActiveWorkbook.Path
  Set synthèse = ActiveWorkbook
   'compteur = 1
  nf = Dir("*.xls")
  Do While nf <> ""
    If nf <> synthèse.Name Then
      Workbooks.Open Filename:=nf
      For k = 1 To Sheets.Count
        Sheets(k).Copy After:=synthèse.Sheets(synthèse.Sheets.Count)
        synthèse.Sheets(synthèse.Sheets.Count).Name = sheet.name
 'compteur = compteur + 1
             Next k
      Workbooks(nf).Close False
    End If
    nf = Dir
  Loop
End Sub

Lorsque je lance la macro, depuis mon fichier "synthèse", il y a bien importation de la feuille 1 du fichier "metz" mais après cela bug et la ligne 11 de la macro est surlignée en jaune (erreur d'exécution 424, "objet requis")
Une idée car cela dépasse mon humble niveau ! Merci

[AlainTech]

Bonjour,

La variable sheet n'a pas été déclarée et encore moins assignée.

Je te propose ceci:

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
Sub consolide()
  Dim nf As String
  Dim strPath As String
  Dim synthese As Workbook
  Dim wbkSource As Workbook
  Dim wksSource As Worksheet
 
  strPath = ActiveWorkbook.Path
  Set synthese = ActiveWorkbook
  nf = Dir(strPath & "\*.xls")
  Application.EnableEvents = False
 
  Do While nf <> ""
    If nf <> synthese.Name Then
      Set wbkSource = Workbooks.Open(Filename:=strPath & "\" & nf)
      For Each wksSource In wbkSource.Worksheets
        wksSource.Copy After:=synthese.Sheets(synthese.Sheets.Count)
      Next wksSource
      wbkSource.Close False
    End If
    nf = Dir
  Loop
 
  Application.EnableEvents = True
End Sub

J'ai supprimé l'accent de "synthèse", c'est peu recommandé dans les noms de variables.

J'ai aussi supprimé le renommage de la feuille puisqu'elle est copiée avec son nom.

Un conseil, force la déclaration des variables en mettant Option Explicit en haut de chaque module de code.
Ca t'évitera le désagrément que tu viens d'avoir.

[mikadoo57]

Bonjour AlainTech
je viens d'essayer le code fourni mais il y a "erreur d'exécution 1004", il ne trouve pas le fichier "Metz.xls" alors qu'il est bien présent dans le dossier !
Lorsque j'ouvre le débogueur, la ligne 14 ci-dessous est surlignée en jaune.

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
Option Explicit
Sub consolide()
  Dim nf As String
  Dim strPath As String
  Dim synthese As Workbook
  Dim wbkSource As Workbook
  Dim wksSource As Worksheet
  strPath = ActiveWorkbook.Path
  Set synthese = ActiveWorkbook
  nf = Dir(strPath & "\*.xls")
  Application.EnableEvents = False
  Do While nf <> ""
    If nf <> synthese.Name Then
      Set wbkSource = Workbooks.Open(Filename:=nf)
      For Each wksSource In wbkSource.Worksheets
        wksSource.Copy After:=synthese.Sheets(synthese.Sheets.Count)
      Next wksSource
      wbkSource.Close False
    End If
    nf = Dir
  Loop
  Application.EnableEvents = True
End Sub

[AlainTech]

Bonjour,

Et comme ça?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set wbkSource = Workbooks.Open(Filename:=strPath & "\" & nf)

Corrigé dans mon premier message.

[mikadoo57]

Bonjour Alain,
cette fois, il y a arrêt sur la ligne 18 de ton code ("next wksSource") avec le message : "erreur de compilation. référence de variable de contrôle incorrecte dans next".
Par ailleurs, je ne l'ai pas explicitement indiqué, mais le but est de n'importer que la feuille 1 de chaque fichier (dénommée "Activités").

(Je ne peux pas mettre d'exemple de fichier utilisé car nous travaillons sur un Intranet sécurisé d'où rien ne peut sortir!)

[mikadoo57]

Bon j'ai trouvé la solution qui fonctionne.
c'est pas du travail très propre, mais au moins ça marche : je fais un pastespecial pour chaque feuille à importer. 8 lignes de code par feuille x 8 classeurs cela fait une macro de 64 lignes
Voici à quoi ressemble le code pour chaque feuille à importer :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
sub import()
workbooks.open filename:="nom_du_fichier_origine.xls"
range("A3:L30002")select
selection copy
windows("nom_du_fichier_de_destination.xls").activate
worksheets("nom_de_la_feuille_de_destination").activate
range("A3").select
selection.pastespecial paste:=xlpastevalues
woorkbooks("nom_du_fichier_origine.xls").close savechange=false

Je n'ai pas encore saisi la différence entre Windows et Workbooks car le résultat est identique en les interchangeant
Dernière question : comment ne pas faire apparaitre le message concernant la sauvegarde du presse papier qui surgit après chaque copie (donc 8 fois!) ?

[kiki29]

Salut,

c'est pas du travail très propre

C'est le moins que l'on puisse dire ... tu peux supprimer au moins les select qui ralentisse l'ensemble.
La solution d'Alain étant la meilleure et de loin, peut-être à affiner et corriger ? ( pas testé de mon côté )

Place ceci à l'endroit idoine

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.CutCopyMode = False

[mikadoo57]

Salut Kiki
malheureusement, le code d'Alain bute sur le "next" (ligne 18). Moi-même je ne peux rien faire car ne connaissant pas la syntaxe VBA, j'adapte les codes des autres en fonction de mes maigres connaissances, de mon intuition et de l'aide bénéfique des connaisseurs.
Supprimer les .select ? = message d'erreur sur Range

a ligne de code que tu me donnes, placée en avant dernière ligne résout le problème. je te remercie.

[kiki29]

Salut, ce que je veux dire par supprimer c'est par exemple :
Remplacer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
range("A3:L30002").select
selection.copy

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

range("A3:L30002").copy

etc

[mikadoo57]

OK merci.