Discussion :

[djemol]

Bonjour

J'ai un classeur avec une macro qui va chercher plusieurs classeurs dans un autre répertoire spécifique
Lorsque je lance la macro tout ce déroule normalement elle fait bien le travail
Mais les classeurs qui se trouve dans le répertoire sont enregistré sur des feuil nommé "En tête"
Jusqu'ici la macro fonctionne très bien
Mais parfois les techniciens n'enregistre pas sur "En tête" il ferme et enregistre le classeur sur une autre feuil nommé "Réserves-Commentaires"

Le problème la macro ne fait pas la différence entre "En tête" et "Réserves-Commentaires" ce qui fait qu'il enregistre sur les deux feuil
J'aimerais avoir votre aide pour que la macro puisse récupérer les informations toujours sur "En tête" même si les techniciens l'enregistre sur "Réserves-Commentaires"
Il faut savoir que le classeur ou ce trouve "En tête" est écrit t elle quel avec un espace et l'accent

Je vous remercie a l'avance

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
26
27
28
Sub recup()
Range("A2").Select 'sélectionner la cellule de début
Chemin = "C:\Users\J_H\Desktop\Prev suivi\" 'saisir le chemin complet du dossier où se trouvent les fichiers
Fichier = Dir(Chemin & "*.*") ' Premier fichier
Do While Fichier <> ""
Workbooks.Open Filename:=Chemin & Fichier
Range("D5").Copy
ThisWorkbook.Activate
ActiveSheet.Paste
Windows(Fichier).Activate
Application.CutCopyMode = False
ActiveWorkbook.Close savechanges:=False
ThisWorkbook.Activate
Range("A3").End(xlUp).Offset(1, 0).Select
Range("A4").End(xlUp).Offset(1, 0).Select
Range("A5").End(xlUp).Offset(1, 0).Select
Range("A6").End(xlUp).Offset(1, 0).Select
Range("A7").End(xlUp).Offset(1, 0).Select
Range("A8").End(xlUp).Offset(1, 0).Select
Range("A9").End(xlUp).Offset(1, 0).Select
Range("A10").End(xlUp).Offset(1, 0).Select
Range("A11").End(xlUp).Offset(1, 0).Select
Range("A12").End(xlUp).Offset(1, 0).Select
Range("A13").End(xlUp).Offset(1, 0).Select
Range("A14").End(xlUp).Offset(1, 0).Select
Fichier = Dir ' Fichier suivant
Loop
End Sub

[Invité]

Bonjour,

A tester :

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
26
27
28
29
30
31
32
33
 
Option Explicit
 
Sub Recup()
 
Dim WbSource As Workbook
Dim ShEnTete As Worksheet
Dim Chemin As String, Fichier As String
Dim LigneEnCours As Long
 
    Set ShEnTete = Sheets("En tête")
    With ShEnTete
 
         LigneEnCours = 2
         Chemin = "C:\Users\J_H\Desktop\Prev suivi\" 'saisir le chemin complet du dossier où se trouvent les fichiers
         Fichier = Dir(Chemin & "*.*") ' Premier fichier
 
         Do While Fichier <> ""
            Set WbSource = Workbooks.Open(Filename:=Chemin & Fichier)
            With WbSource
                 .Sheets(1).Range("D5").Copy Destination:=ShEnTete.Cells(LigneEnCours, 1)
                 .Close savechanges:=False
            End With
            Set WbSource = Nothing
 
            LigneEnCours = LigneEnCours + 1
            Fichier = Dir ' Fichier suivant
         Loop
 
    End With
    Set ShEnTete = Nothing
 
End Sub

[djemol]

Bonjour

Merci a toi de me venir an aide

Mais j'ai une erreur au niveau Set ShEnTete = Sheets("En tête")

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
26
27
28
29
30
Sub Recup1()
 
Dim WbSource As Workbook
Dim ShEnTete As Worksheet
Dim Chemin As String, Fichier As String
Dim LigneEnCours As Long
 
    Set ShEnTete = Sheets("En tête")
    With ShEnTete
 
         LigneEnCours = 2
         Chemin = "C:\Users\J_H\Desktop\Prev suivi\" 'saisir le chemin complet du dossier où se trouvent les fichiers
         Fichier = Dir(Chemin & "*.*") ' Premier fichier
 
         Do While Fichier <> ""
            Set WbSource = Workbooks.Open(Filename:=Chemin & Fichier)
            With WbSource
                 .Sheets(1).Range("D5").Copy Destination:=ShEnTete.Cells(LigneEnCours, 1)
                 .Close savechanges:=False
            End With
            Set WbSource = Nothing
 
            LigneEnCours = LigneEnCours + 1
            Fichier = Dir ' Fichier suivant
         Loop
 
    End With
    Set ShEnTete = Nothing
 
End Sub

[Invité]

Mais j'ai une erreur au niveau Set ShEnTete = Sheets("En tête")

Quel est le nom exact de l'onglet ?

A quel endroit l'erreur se situe ? Ligne en jaune.

[djemol]

Re

Le nom exacte "En tête"

Voila la ligne exacte

Set ShEnTete = Sheets("En tête")

Merci

[Invité]

Testez ce fichier