XL 2016 [Réglé] Importer certaines données depuis fichiers dans dossier

[Service Numérique]

Bonjour à toutes et tous,

J'ai déjà parcouru nombreux forums, essayé de nombreuses macro etc, mais rien ne me correspond.

Je vous explique mon problème :

Je souhaite créer un fichier de synthèse (via une macro ou autre) de mes rapports de production qui :
- importera (et copiera) toutes les cellules REMPLIES (si possible) de la feuille "Récap détaillé" de la colonne A3 à Txxx (jusqu'à la dernière ligne remplie donc - ou au pire de A3 à T250 ) de TOUS les fichiers .XLS (01-2017.xls; 02-2017.xls; ... ; 06-2017.xls) depuis le dossier "2017" et SANS importer rien d'autre car j'ai trouvé des macros qui fonctionnaient mais y inséraient le nom du classeur ou d'autres données. Et n'y connaissant pas grand chose en macro/VBS, j'ai eu du mal à les éditer.

Si quelqu'un à une idée, merci d'avance.

Bon appétit et merci à ceux qui pourront m'aider.

 

[Robert]

Bonjour SN, bonjour le forum,

Dans le code ci-dessous il te faudra adapter le chemin d'accès CA et éventuellement l'index (= la position) de l'onglet destination OD. Tu crées le fichier synthèse et tu places le code dans un module standard de celui-ci...

Sub Macro1()
Dim CA As String 'déclare la variable CA (Chemin d'Accès)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim F As String 'déclare la variable F (Fichier)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

CA = "C:\blabla\blabla\2017" 'définit le chemin d'accès CA (à adapter à ton cas car il faut le chemin complet au dossier [2017])
Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets(1) 'définit l'onglet destination OD (a adapter a ton cas, ici j'ai mis le premier onglet du classeur destination)
F = Dir(CA & "\*.xls") 'définit le premier fichier excel du dossier [2017]
Do While F <> "" 'boucle tant qui existe d'autres fichiers excel dans le dossier [2017]
  Workbooks.Open (CA & "\" & F) 'ouvre le fichier F
  Set CS = ActiveWorkbook 'définit le classeur source
  On Error GoTo suite 'gestion des erreurs (en cas d'erreur va a l'étiquette suite)
  Set OS = CS.Worksheets("Récap détaillé") 'définit l'onglet source (génère une erreur si l'onglet "Récap détaillé" n'existe pas)
  DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet source OS
  'définit la cellule de destination dans l'onglet OD (A1 si A1 est vide, sinon, la première cellule vide de la colonne A)
  Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0))
  OS.Range("A3:T" & DL).Copy DEST 'copie la plage éditée des colonne A à T de l'onglet source et la colle dans DEST
suite: 'étiquette
  Err.Clear 'supprime l'erreur
  CS.Close False 'ferme le classeur source sans enregistrer
  On Error GoTo 0 'annule la gestion des erreurs
  F = Dir 'définit le prochain fichier excel du dossier [2017]
Loop 'boucle
End Sub

 

[Service Numérique]

Bonjour,

Merci, je vais tester ça...

 

[Service Numérique]

Bonjour,

Désolé pour la réponse tardive.

Ça fonctionne nickel !
Merci beaucoup.

Bon appétit et bonne fin de semaine.