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

Excellerateur

XLDnaute Occasionnel
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,
 
Solution
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, _...

Etoto

XLDnaute Barbatruc
En effet j'ai utilisé ce code ci et ça marche bien jusqu'à ceci Regarde la pièce jointe 1109793

Je suis obligé de valider manuellement le "OK" pour que le code marche.
Mais sinon c'est déjà un petit pas pour 'humanité, mais un pas de géant pour wam 🤩
Hello !!! Désolé de la réponse tardive ! Je crois avoir une solution plus facile pour empêcher cette fenêtre d'apparaître. Il faut insérer dans ta macro un code qui supprime tout le tableau importé avant la création du Array.

Si ton tableau fait 10 colonnes, voici le code ;
VB:
Sub Import_Data()
    Columns("A:J").Select
    Selection.ClearContents
    Range("A1").Select
    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, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

End Sub


Attention !!! TOUTES les données de ces colonnes vont être supprimées de la ligne 1 jusqu'à la ligne 1048576 !!
 

Discussions similaires

Statistiques des forums

Discussions
315 095
Messages
2 116 170
Membres
112 676
dernier inscrit
little_b