Microsoft 365 Créer une macro qui va dans un dossier récupérer un fichier

Excellerateur · 22 Juin 2021

Bonjour chers membres!

Je voudrais pourvoir faire une macro qui va aller dans un dossier de mon pc, puis récupérer un fichier qui se trouve dans un dossier, l'ouvrir et copier toute une plage de ce fichier et venir la coller dans l'onglet de destination prévu dans mon fichier (celui de la macro).

Je ne sais pas si il faudrait que je produise le fichier , mais je n'en suis pas sûr.

Néanmoins voici ce que j'ai obtenu comme code:

VB:

Sub maj_extraction_de_donnees()

'

' maj_extraction_de_données Macro

'


'

    Sheets("Donnees").Select

    Range("A2:E3138").Select

    Selection.ClearContents

    Range("A1:E2644").Select

    Selection.Copy

    Windows("Outil de franchissement.xlsm").Activate

    Sheets("Donnees density").Select

    Range("A2").Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Range("A1").Select

    Windows("Equity.csv").Activate

    Application.CutCopyMode = False

    Windows("Outil de franchissement.xlsm").Activate

End Sub

Mais mon code n'est pas optimal car quand je ferme et qu'une autre personne l'ouvre, il ne part pas ans le réseau chercher le ficher dans lequel la copie doit être faite.

Merci de votre aide.

Bien cordialement,

Etoto · 30 Juin 2021

Exemple avec le code :

VB:

Sub Import_Data()
    Dim Chemin As String
    Chemin = [B1]
    Workbooks.Open Filename:= Chemin, ReadOnly:=True
    Sheets("Deliveries").Select
    last = Range("A1048576").End(xlUp).Row
    oArray = Range("A2:S" & last)
    Workbooks("Fichier.xlsx").Close SaveChanges = 0
    Windows(NomFichier).Activate
    Sheets("Data").Select
    On Error Resume Next
    Sheets("Data").ShowAllData
    On Error GoTo 0
    Range("T3:AG1048576").Clear
    Range("A2:S1048576").ClearContents
    Range("A2:S" & last) = oArray
    Erase oArray
    Range("T2:AG2").AutoFill Destination:=Range("T2:AG" & last)
    Range("la zone à convertir").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _...

D.D. · 25 Juin 2021

Etoto à dit:
Re,

Je vois que tu fais un lien entre des classeurs et un fichier CSV ? Tu sais que c'est aussi le job de Power Query ?

EDIT : Mais ça fonctionne seulement avec une plage qui est un tableau.

Bonjour à tous,

Perso, je fais plutôt comme le fait @Excellerateur .
PowerQuery c'est bien, mais cela bloque le fichier en lecture seule tant que l'excel qui demande les données est ouvert.
Du coup, et ca peut être le cas dans un répertoire réseau, si une mise à jour du fichier source doit se faire, la mise à jour échoue. Et c'est gênant.

En ouvrant le fichier, en récupérant ses données et en fermant tout de suite on évite le problème.

Une autre solution alternative que je n'ai jamais essayer:
Une VBA du fichier contenant PowerQuery duplique le fichier source et PowerQuery s'alimente via le duplicat. Du coup si une mise à jour doit se faire, le fichier reste accessible.

Bien à vous tous.

Excellerateur · 25 Juin 2021

D.D. à dit:
Bonjour à tous,

Perso, je fais plutôt comme le fait @Excellerateur .
PowerQuery c'est bien, mais cela bloque le fichier en lecture seule tant que l'excel qui demande les données est ouvert.
Du coup, et ca peut être le cas dans un répertoire réseau, si une mise à jour du fichier source doit se faire, la mise à jour échoue. Et c'est gênant.

En ouvrant le fichier, en récupérant ses données et en fermant tout de suite on évite le problème.

Une autre solution alternative que je n'ai jamais essayer:
Une VBA du fichier contenant PowerQuery duplique le fichier source et PowerQuery s'alimente via le duplicat. Du coup si une mise à jour doit se faire, le fichier reste accessible.

Bien à vous tous.

Surtout que je ne suis pas administrateur du pc et donc pas moyen de télécharger PowerQuery.

Excellerateur · 25 Juin 2021

Etoto à dit:
Re,

Un OpenWorkBook fait le travail mais je dois partir désolé, je répond plus tard.

Ok merci pour ta générosité.

D.D. · 25 Juin 2021

Excellerateur à dit:
Surtout que je ne suis pas administrateur du pc et donc pas moyen de télécharger PowerQuery.

C'est pas compris dans l'Office 365 que tu mentionnes avoir ?

Excellerateur · 25 Juin 2021

J'ai par exemple aussi essayé avec l'instruction inscrite dans le bout de code suivant pas ça marche toujours pas. Je me suis inspiré de la vidéo du lien ici

VB:

Sub Testeur()
'
' Testeur Macro
    Dim NomFichier As String
    
    Sheets("INSTRUCTIONS").Select
    Range("A1").Select
    
    NomFichier = VBA.FileSystem.Dir("\\219.122.2.345\Distribution\POD\03Cac\In\HISTOVL_278015_20210625104803.xls?")
    
    Workbooks.Open "\\219.122.2.345\Distribution\POD\03Cac\In\" & NomFichier
    
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy

Excellerateur · 25 Juin 2021

D.D. à dit:
C'est pas compris dans l'Office 365 que tu mentionnes avoir ?

Ah ok je savais même pas que l'appli était dans la suite Office. Merci!

Mais je ne sais pas si il y a donc une manip à faire pour l'activer ou alors c'est déjà actif par défaut?

D.D. · 25 Juin 2021

Excellerateur à dit:
Mais je ne sais pas si il y a donc une manip à faire pour l'activer ou alors c'est déjà actif par défaut?

C'est actif par défaut:
Données, Obtenir des données

Etoto · 25 Juin 2021

Excellerateur à dit:
Oui c'est exactement ce que j'ai fait mon très cher @Etoto, mais le code n'enregistre pas le chemin dans vba.

je ne comprends justement pas pourquoi

Re,

C'est bizarre, j'ai le même problème sur mon ordi personnel mais pas sur mon ordi professionnel, très étrange !

Excellerateur · 28 Juin 2021

Etoto à dit:
Re,

C'est bizarre, j'ai le même problème sur mon ordi personnel mais pas sur mon ordi professionnel, très étrange !

Ah oui? Bizarre ça! Je vais essayer aussi avec mon ordi perso!

Etoto · 28 Juin 2021

Re,

Attend voilà le code pour ouvrir un fichier

VB:

Sub Macro 1()

    Worbooks.Open Filename :=
        "ton chemin et le nom du fichier"
    Range("ta zone à copier").Select
    Selection.Copy
    Windows("ton fichier").Activate
    Range("ta zone de collage").Select
    ActiveSheet.Paste
End Sub

J'ai modifié

D.D. · 28 Juin 2021

Etoto à dit:
Re,

Attend voilà le code pour ouvrir un fichier

Hello,

Pour ma part voici mon code complet (ouverture, récup des données, fermeture, insertion des données):
je n'aime pas trop les "Copy Paste" en VBA, alors je passe par un Array.
A noter la copie de formules en T:AG (= colonnes adjacentes aux données)

VB:

Sub Import_Data()
    Workbooks.Open Filename:="Y:\xxx\yyy\Fichier.xlsx", ReadOnly:=True
    Sheets("Deliveries").Select
    last = Range("A1048576").End(xlUp).Row
    oArray = Range("A2:S" & last)
    Workbooks("Fichier.xlsx").Close SaveChanges = 0
    Windows("Analyse.xlsb").Activate
    Sheets("Data").Select
    On Error Resume Next
    Sheets("Data").ShowAllData
    On Error GoTo 0
    Range("T3:AG1048576").Clear
    Range("A2:S1048576").ClearContents
    Range("A2:S" & last) = oArray
    Erase oArray
    Range("T2:AG2").AutoFill Destination:=Range("T2:AG" & last)
End Sub

Etoto · 28 Juin 2021

D.D. à dit:
Hello,

Pour ma part voici mon code complet (ouverture, récup des données, fermeture, insertion des données):
je n'aime pas trop les "Copy Paste" en VBA, alors je passe par un Array.
A noter la copie de formules en T:AG (= colonnes adjacentes aux données)

VB:

Sub Import_Data() Workbooks.Open Filename:="Y:\xxx\yyy\Fichier.xlsx", ReadOnly:=True Sheets("Deliveries").Select last = Range("A1048576").End(xlUp).Row oArray = Range("A2:S" & last) Workbooks("Fichier.xlsx").Close SaveChanges = 0 Windows("Analyse.xlsb").Activate Sheets("Data").Select On Error Resume Next Sheets("Data").ShowAllData On Error GoTo 0 Range("T3:AG1048576").Clear Range("A2:S1048576").ClearContents Range("A2:S" & last) = oArray Erase oArray Range("T2:AG2").AutoFill Destination:=Range("T2:AG" & last) End Sub

Re,

Excellent !!

On pourrait même corser en faisant un

VB:

Sub Import_Data()
    Dim Chemin As String
    Dim NomFichier As String
    Chemin = [B1]
    NomFichier = [B2]
    Workbooks.Open Filename:= Chemin & NomFichier, ReadOnly:=True
    Sheets("Deliveries").Select
    last = Range("A1048576").End(xlUp).Row
    oArray = Range("A2:S" & last)
    Workbooks("Fichier.xlsx").Close SaveChanges = 0
    Windows(NomFichier).Activate
    Sheets("Data").Select
    On Error Resume Next
    Sheets("Data").ShowAllData
    On Error GoTo 0
    Range("T3:AG1048576").Clear
    Range("A2:S1048576").ClearContents
    Range("A2:S" & last) = oArray
    Erase oArray
    Range("T2:AG2").AutoFill Destination:=Range("T2:AG" & last)
End Sub

Comme ça, il écrit le chemin en B1 et le nom du fichier en B2 et il peut avoir un code dynamique.

D.D. · 28 Juin 2021

Etoto à dit:
Comme ça, il écrit le chemin en B1 et le nom du fichier en B2 et il eux avoir un code dynamique.

Oui, c'est vrai

VB:

    Dim Chemin As String
    Dim NomFichier As String

Je ne déclare jamais mes variables. La flemme... Je suis un peu faignante pour ca.

Etoto · 28 Juin 2021

D.D. à dit:
Oui, c'est vrai

VB:

Dim Chemin As String Dim NomFichier As String

Je ne déclare jamais mes variables. La flemme... Je suis un peu faignante pour ca.

Re,

Oui mais des fois avec les variant, il peut avoir des bugs, mais dans un code comme celui-ci, j'aurais pu les laisser en variant.

Etoto · 28 Juin 2021

Re,

En tout cas ton code est super, je suis encore un débutant en VB (je suis en train de faire un cours en VBA Excel avec un PDF de 226 pages ) et je ne pensais pas qu'un Array pouvait remplacer un copié-collé et c'est sûr que c'est plus simple. Merci de ce code

Cordialement,

Microsoft 365 Créer une macro qui va dans un dossier récupérer un fichier

Excellerateur

XLDnaute Occasionnel

Etoto

D.D.

XLDnaute Impliqué

Excellerateur

XLDnaute Occasionnel

Excellerateur

XLDnaute Occasionnel

D.D.

XLDnaute Impliqué

Excellerateur

XLDnaute Occasionnel

Excellerateur

XLDnaute Occasionnel

D.D.

XLDnaute Impliqué

Etoto

XLDnaute Barbatruc

Excellerateur

XLDnaute Occasionnel

Etoto

XLDnaute Barbatruc

D.D.

XLDnaute Impliqué

Etoto

XLDnaute Barbatruc

D.D.

XLDnaute Impliqué

Etoto

XLDnaute Barbatruc

Etoto

XLDnaute Barbatruc

Discussions similaires