Microsoft 365 Macro pour récupérer des données dans plusieurs fichiers identiques

[Coralie01120]

Bonjour,

Je cherche à récupérer via une macro des données dans plusieurs fichiers (identiques dans le même répertoire) afin de me faire une BDD en gagnant du temps.
J'ai plus d'une centaine de fichiers. Je vous en joins 2 pour l'exemple (classeur1 et classeur2).
Les fichiers sont tous répertoriés sous Z:\COLLABORATEURS\Coralie\TEST

Ainsi, les données à récupérer sont toujours : B1 = client, B8 la commande et D8 la date.
Mon objectif est de faire ma BDD dans l'onglet BDD du fichier macro comme ceci : en colonne A le client, en colonne B la commande et en colonne C la date.

J'ai déjà commencé à faire ma macro mais elle ne fonctionne pas...

La voici :

Sub listerLesFichiers()

Application.ScreenUpdating = False

Dim chemin As String, Fichier As String

chemin = "Z:\COLLABORATEURS\Coralie\TEST\"
Fichier = Dir(chemin & "*" & ".xlsx", vbNormal)

Do While Fichier <> ""

With Workbooks.Open(chemin & Fichier)
.Activate

DerLigneVide = Workbooks("macro.xlsm").Sheets("BDD").Range("A" & Rows.Count).End(xlUp).Row + 1
Workbooks("macro.xlsm").Sheets("BDD").Cells(DerLigneVide, 1) = ActiveWorkbook.Sheets("Feuil1").Range("B1")


DerLigneVide = Workbooks("macro.xlsm").Sheets("BDD").Range("B" & Rows.Count).End(xlUp).Row + 1
Workbooks("macro.xlsm").Sheets("BDD").Cells(DerLigneVide, 2) = ActiveWorkbook.Sheets("Feuil1").Range("B8")

DerLigneVide = Workbooks("macro.xlsm").Sheets("BDD").Range("C" & Rows.Count).End(xlUp).Row + 1
Workbooks("macro.xlsm").Sheets("BDD").Cells(DerLigneVide, 3) = ActiveWorkbook.Sheets("Feuil1").Range("D8")

End With

Fichier = Dir
Loop

Call FermerTousClasseurs

Application.ScreenUpdating = True

End Sub

Sub FermerTousClasseurs()

Application.DisplayAlerts = False

Dim Classeur As Workbook
For Each Classeur In Workbooks
If Classeur.Name <> ThisWorkbook.Name Then
Classeur.Close SaveChanges:=False
End If
Next Classeur

Application.DisplayAlerts = True

Je vous joins les fichiers pour que cela soit plus clair.

Merci pour votre aide et très bonne soirée,

End Sub

 

[sylvanu]

Bonsoir Coralie,
Un essai en PJ avec :

Sub listerLesFichiers()
Application.ScreenUpdating = False
Dim chemin As String, Fichier As String, F

chemin = "C:\Users\PC_PAPA\Desktop\Coralie\"        ' A modifier !
Fichier = Dir(chemin & "*" & ".xlsx", vbNormal)
Set M = Workbooks("macro (1).xlsm").Sheets("BDD")

Do While Fichier <> ""
    DerLigneVide = M.Range("A65500").End(xlUp).Row + 1
    With Workbooks.Open(chemin & Fichier)
        Set F = Workbooks(Fichier).Sheets("Feuil1")
        .Activate
        M.Cells(DerLigneVide, 1) = F.Range("B1")
        M.Cells(DerLigneVide, 2) = F.Range("B8")
        M.Cells(DerLigneVide, 3) = F.Range("D8")
    End With
    ActiveWorkbook.Close    ' Ferme le classeur de données
Fichier = Dir
Loop

End Sub

 

[Coralie01120]

Bonjour Sylvanu,

Ta macro fonctionne parfaitement. J'ai une question je viens de voir que tous les fichiers que je souhaite ouvrir contiennent une feuille protégée par un mot de passe. Je n'arrive pas à inclure la déprotection de la feuille dans ma macro.

Je te joins un exemple. J'ai un fichier "TEST" composé de plusieurs classeurs de type .ods (pour l'exemple je n'ai laissé que classeur1). Ta macro qui ouvre plusieurs classeurs fonctionne parfaitement.
Ici quand j'ouvre mon classeur j'ai un message d'erreur qui me dit que mon classeur est protégé par un mot de passe donc ma macro n'ouvre pas le fichier... Cette feuille protégé est Feuil2

Le mot de passe est : coralie

Voici ma macro :

Sub listerLesFichiers()
Application.ScreenUpdating = False
Dim chemin As String, Fichier As String, F, E

chemin = "C:\Users\largeronc\OneDrive - BELPACK SNC\Bureau\TEST\"
Fichier = Dir(chemin & "*" & ".ods", vbNormal)
Set M = Workbooks("macro.xlsm").Sheets("BDD")

Do While Fichier <> ""
DerLigneVide = M.Range("A65500").End(xlUp).Row + 1
With Workbooks.Open(chemin & Fichier)

Set E = Workbooks(Fichier).Sheets("Feuil2")
For Each E In ActiveWorkbooks.Worksheets
E.Unprotect Password:="coralie"
Next
'With Sheets("Feuil2").Unprotect("coralie")
Set F = Workbooks(Fichier).Sheets("Feuil1")
.Activate
M.Cells(DerLigneVide, 1) = F.Range("P1") 'Date
M.Cells(DerLigneVide, 2) = F.Range("P8") 'Bordereaux
M.Cells(DerLigneVide, 3) = F.Range("D8") 'Client
M.Cells(DerLigneVide, 4) = F.Range("A14") 'Of
M.Cells(DerLigneVide, 5) = F.Range("D24") 'Forme découpe
M.Cells(DerLigneVide, 6) = F.Range("F26") 'Outil de dorure
M.Cells(DerLigneVide, 7) = F.Range("J24") 'Outil de gaufrage
M.Cells(DerLigneVide, 8) = F.Range("A34") 'Of
M.Cells(DerLigneVide, 9) = F.Range("D44") 'Forme découpe
M.Cells(DerLigneVide, 10) = F.Range("F46") 'Outil de dorure
M.Cells(DerLigneVide, 11) = F.Range("J44") 'Outil de gaufrage
End With

ActiveWorkbook.Saved = True
ActiveWorkbook.Close ' Ferme le classeur de données
Fichier = Dir
Loop

End Sub

Belle journée,

 

[Laurent78]

Bonjour,
pourquoi ne pas utiliser PowerQuery ?
cf : https://www.excel-downloads.com/threads/conversion-dun-tableau-en-liste.20054402/#post-20407908

 

[sylvanu]

Bonjour Coralie, Laurent,
Pour protéger, déprotéger une feuille :

Sub Protection()
    Sheets("Feuil2").Protect Password:="coralie"
End Sub
Sub Déprotection()
    Sheets("Feuil2").Unprotect Password:="coralie"
End Sub

 

[Coralie01120]

Bonjour Sylvanu et Laurent,

J'ai utilisé le code proposé par Syivanu mais il y a toujours le message d'erreur. C'est peut être une question de position mais je ne trouve pas... A savoir que si j'enlève le mot de passe je n'ai plus de problème. Cen'est donc pas le format ods qui pose soucis.

Voici mon code :

Sub listerLesFichiers()
Application.ScreenUpdating = False
Dim chemin As String, Fichier As String, F

chemin = "C:\Users\largeronc\OneDrive - BELPACK SNC\Bureau\TEST\"
Fichier = Dir(chemin & "*" & ".ods", vbNormal)
Set M = Workbooks("macro.xlsm").Sheets("BDD")

Do While Fichier <> ""
DerLigneVide = M.Range("A65500").End(xlUp).Row + 1
With Workbooks.Open(chemin & Fichier)
Workbooks(Fichier).Sheets("Feuil2").Unprotect Password:="coralie"
Set F = Workbooks(Fichier).Sheets("Feuil1")
.Activate

 

[sylvanu]

Ce que je ne comprends pas c'est que votre message d'erreur dit que c'est le fichier qui est protégé, non une feuille ?

 

[sylvanu]

C'est ce que j'ai fait.
Mais pour le faire runner il me faudrait les fichiers adéquat en ods.
Donc ca ne me sert pas à grand chose.

 

[Coralie01120]

Il s'agit pourtant d'une feuille. J'ai essayé de le convertir en xls et meme avec le mot de passe la macro fonctionne. En ods sans mot de passe également.

C'est le mot de passe et l'extension .ods qui ne fonctionne pas.

Je vous joins le fichier en format .xls qu'il faudra convertir en ods (l'extension .ods n'est pas possible) ainsi que le fichier de la macro.

 

[sylvanu]

Moi, j'ai une erreur sur

    For Each E In ActiveWorkbooks.Worksheets
        E.Unprotect Password:="coralie"
    Next

Syntaxe que je comprends pas.
Je l'ai remplacé par :

    For I = 1 To ActiveWorkbook.Worksheets.Count
        Sheets(I).Unprotect Password:="coralie"
    Next

et au moins ça ne plante pas et ça remplit la feuille BDD.

 

[Coralie01120]

Merci pour vos réponses.
J'ai appliqué votre code mais il y a toujours ce message d'erreur. Vous l'avez passé en ods ?

 

[sylvanu]

Non. J'ai laissé en xls et modifié le code en conséquence.

chemin = "C:\Users\PC_PAPA\Desktop\Coralie\"   
Fichier = Dir(chemin & "*" & ".xls", vbNormal)

Je vais retenter en ods...

Sur 2007 il me jette à cause de l'extension non reconnue :

 

[Coralie01120]

Mince je n'ai pas ce message de mon coté.
Serait il plus simple de réfléchir dans l'autre sens et de convertir tous mes fichiers ods en xls ?

 

[sylvanu]

Je ne sais pas si 365 reconnait ce format. Donc je ne peux pas répondre.
Mais 2007 est vieux, peut être est ce la raison.
Apparemment c'est un format compris de LibreOffice et OpenOffice, donc devrait être compris de votre 365.
Mais là je ne peux pas vous aider.
( mais pour tester faites un dossier avec des fichiers xls pour voir. Je vous offre même le convertisseur.
https://document.online-convert.com/fr/convertir/ods-en-excel )
et de la lecture sur les différences ods xls :

Différences entre le format Feuille de calcul OpenDocument (.ods) et le format Excel pour Windows (.xlsx) - Support Microsoft

Découvrez les fonctionnalités prises en charge dans Excel lorsque vous utilisez des formats de fichier OpenDocument (.ods) et Excel pour Windows (.xlsx).

support.microsoft.com

 

[Coralie01120]

Merci je vais regarder. En effet un classeur au format ods contenant des feuilles protégées par un mot de passe ne peut pas s'ouvrir...

J'opte pour la conversion. Merci pour ton aide.
Bonne soirée