Un peu d'ordre dans cette macro
Bonjour,
Je tente d'adapter une macro trouvée sur ce forum mais il me manque un petit quelque chose....
Je vais avoir des centaines de fichiers intitulé devisENTREPRISE1, devisENTREPRISE2,.... Et je souhaite réaliser un fichier de recap qui va aller me chercher des infos sans même ouvrir lesdit fichier (ça c'est ouf je trouve de pouvoir faire cela )
Je crois que la macro fonctionne bien mais je ne sais pas comment lui dire: Mets la cellule C16 dans la colonne G; met C17 en B .....
Pourriez vous me guider?
Merci
Bonsoir Wikimel,
Essayez plutôt ceci, sans connexion ADO (inutile dans ce cas)
Sub Import()
Dim Repertoire As String, Fich As String, NomFeuille As String
Dim Ligne As Long, f
Dim fso As Object, FsoFolder As Object, oFile As Object
'--- répertoire des fichiers "devis" est le même que le répertoire du fichier Récap---
Repertoire = ThisWorkbook.Path
'--- nom de la feuille des fichiers "devis"---
NomFeuille = "devis"
Set fso = CreateObject("Scripting.FileSystemObject")
Set FsoFolder = fso.GetFolder(Repertoire)
For Each oFile In FsoFolder.Files
f = Split(oFile, "\")
Fich = f(UBound(f))
'--- lire uniquement les fichiers dont le nom commence par "devis" et ont un extention "xlsm"---
If Left(Fich, 5) = "devis" And Right(Fich, 4) = "xlsm" Then 'à adapter'
'--- derniere ligne de la feuille active, les données seront transférées à cette endroit ---
Ligne = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1
Range("A" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!C18"
Range("B" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!C17"
Range("C" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!H9"
Range("D" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!C19"
Range("E" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!E15"
Range("F" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!J29"
Range("G" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!C16"
With Range("A" & Ligne & ":G" & Ligne)
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
End If
Next oFile
End Sub@+
Salut à tous,
Oui Bruno cela simplifies tout de cette manière,
Bonjour et merci BrunoM45. ça fontionne parfaitement bien et en plus je vais pouvoir la réutiliser à pleins d'occasions!!!
Un grand merci. Bon dimanche
Bonjour à tous,
Le fichier recap fonctionne super bien sur mon PC perso mais sur mon PC pro j'ai une erreur d'exécution et la phrase suivante est surlignée en jaune :
Set FsoFolder = fso.GetFolder(Repertoire)
Ce sont bien exactement les mêmes fichiers.
Sur mon PC pro je suis sur le pack 365 de windows. Savez vous d'ou le bug peut venir? C'est lié à la sécurité du PC?
Merci
Bonjour Wikimel,
Il n'y a pas de raison
Après que donne la variable "Repertoire", mettre un point d'arrêt (F9) sur la ligne et le curseur dessus au moment du débogage
Sinon il se peut que ce soit un problème de sécurité, cela peut fonctionner avec une commande basique Dir()
Sub Import2()
Dim Repertoire As String, Fich As String, NomFeuille As String
Dim Ligne As Long
'--- répertoire des fichiers "devis" est le même que le répertoire du fichier Récap---
Repertoire = ThisWorkbook.Path & "\"
'--- nom de la feuille des fichiers "devis"---
NomFeuille = "devis"
' Directory des fichiers devis*
Fich = Dir(Repertoire & "devis*.xlsm")
' Si la directory contient un fichier
Do While Fich <> ""
' Dernière ligne remplie + 1
Ligne = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1
' Inscrire les formules
Range("A" & Ligne).FormulaLocal = "='" & Repertoire & "\[" & Fich & "]" & NomFeuille & "'!C18"
Range("B" & Ligne).FormulaLocal = "='" & Repertoire & "\[" & Fich & "]" & NomFeuille & "'!C17"
Range("C" & Ligne).FormulaLocal = "='" & Repertoire & "\[" & Fich & "]" & NomFeuille & "'!H9"
Range("D" & Ligne).FormulaLocal = "='" & Repertoire & "\[" & Fich & "]" & NomFeuille & "'!C19"
Range("E" & Ligne).FormulaLocal = "='" & Repertoire & "\[" & Fich & "]" & NomFeuille & "'!E15"
Range("F" & Ligne).FormulaLocal = "='" & Repertoire & "\[" & Fich & "]" & NomFeuille & "'!J29"
Range("G" & Ligne).FormulaLocal = "='" & Repertoire & "\[" & Fich & "]" & NomFeuille & "'!C16"
' Copier / coller les valeurs
With Range("A" & Ligne & ":G" & Ligne)
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
' Fichier suivant
Fich = Dir
Loop
End Sub@+
Merci Bruno,
Définitivement le tableau recap fonctionne partout sauf pc pro.
J'ai " Erreur d'execution'76' Classe non enregistrée" comme message d'erreur.
ça m'embête car le fichier en l'état me convient nikel. On est sur one drive. J'ai un autre fichier avec des macros et ça fonctionne. C'est juste qu'il ne veut pas aller chercher les infos et les mettre dans recap.
J'ai aussi essayé la macro que tu m'as envoyé mais elle fait un genre de loop et ouvre la fenetre d'exploration(pleins de fois).
C'est quand même bizarre cette affaire...
En fait c'est à cause de One drive!!
J'ai un peu contourné, crée un fichier en local qui n'est pas sous one drive et ça a bien fonctionné sur mon pc pro.
Wikimel,
Forcément si on ne nous dis pas tout
OneDrive n'est pas un lecteur à proprement parlé, mais une espace cloud, donc effectivement cela ne peut pas fonctionner
En revanche, un fichier en local synchronisé avec OneDrive est possible
@+
Bonjour,
Désolée mais ce point me turlupine... ça veut quand même dire que le pack office ne peut pas être utilisé pleinement sur one drive, en mode partage.
On ne peut pas contourner cela dans la macro? En modifiant le workpath?
Re,
Le pack office peut être pleinement utilisé sur OneDrive mais pas le VBA, aucun contournement possible, navré.
Bonne journée
Merci Bruno
Bonne soirée
Bonjour,
Je me permet de "ré activer" cette demande.
Vous m'avez communiqué cette super macro que j'utilise beaucoup maintenant dans pleins de situations. Et justement, au fur et à mesure de mon utilisation je me suis rendue compte qu'un point me pose pb.
Est il possible d'ajouter dans cette macro des lignes permettant de ne pas importer plusieurs fois un même devis.
J'avais pensé à "renommer" les fichiers .xlsm en Impdevisxxx une fois le fichier importé afin qu'il ne soient pas importé la prochaine fois que je clic sur "Import"?
En plus ça me permet de voir/ranger les fichiers importés.
J'ai trouvé des macros sur internet pour changer le nom d'un fichier mais c'était à partir d'une liste. Là je voudrais "juste" ajouter 3 lettre au début IMP quand l'import est fait.
Par avance merci beaucoup pour votre aide (encore)
Macro originale:Sub Import()
Dim Repertoire As String, Fich As String, NomFeuille As String
Dim Ligne As Long, f
Dim fso As Object, FsoFolder As Object, oFile As Object
'--- répertoire des fichiers "devis" est le même que le répertoire du fichier Récap---
Repertoire = ThisWorkbook.Path
'--- nom de la feuille des fichiers "devis"---
NomFeuille = "devis"
Set fso = CreateObject("Scripting.FileSystemObject")
Set FsoFolder = fso.GetFolder(Repertoire)
For Each oFile In FsoFolder.Files
f = Split(oFile, "\")
Fich = f(UBound(f))
'--- lire uniquement les fichiers dont le nom commence par "devis" et ont un extention "xlsm"---
If Left(Fich, 5) = "devis" And Right(Fich, 4) = "xlsm" Then 'à adapter'
'--- derniere ligne de la feuille active, les données seront transférées à cette endroit ---
Ligne = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1
Range("A" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!C18"
Range("B" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!C17"
Range("C" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!H9"
Range("D" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!C19"
Range("E" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!E15"
Range("F" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!J29"
Range("G" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!C16"
With Range("A" & Ligne & ":G" & Ligne)
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
End If
Next oFile
End Sub
Bonjour Wikimel
Effectivement
Sub Import()
Dim Repertoire As String, Fich As String, NomFeuille As String
Dim Ligne As Long, f
Dim fso As Object, FsoFolder As Object, oFile As Object
'--- répertoire des fichiers "devis" est le même que le répertoire du fichier Récap---
Repertoire = ThisWorkbook.Path
'--- nom de la feuille des fichiers "devis"---
NomFeuille = "devis"
Set fso = CreateObject("Scripting.FileSystemObject")
Set FsoFolder = fso.GetFolder(Repertoire)
For Each oFile In FsoFolder.Files
f = Split(oFile, "\")
Fich = f(UBound(f))
'--- lire uniquement les fichiers dont le nom commence par "devis" et ont un extention "xlsm"---
If Left(Fich, 5) = "devis" And Right(Fich, 4) = "xlsm" Then 'à adapter'
'--- derniere ligne de la feuille active, les données seront transférées à cette endroit ---
Ligne = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1
Range("A" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!C18"
Range("B" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!C17"
Range("C" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!H9"
Range("D" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!C19"
Range("E" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!E15"
Range("F" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!J29"
Range("G" & Ligne).FormulaLocal = "='" & FsoFolder & "\[" & Fich & "]" & NomFeuille & "'!C16"
With Range("A" & Ligne & ":G" & Ligne)
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
' Import terminé renommer le fichier
Name FsoFolder & "\" & Fich As FsoFolder & "\Imp_" & Fich
End If
Next oFile
End Sub@+
C'est top!!!! Un grand merci ça fonctionne nikel
Bonne soirée