Microsoft 365 Code vba pour Ouvrir un fichier et copier son contenu dans un classeur existant à partir de la boite de dialogue

Faroyo

XLDnaute Junior
Bonjour,

A partir d'un bouton dans un classeur excel, je cherche un code vba qui me permettrai d'ouvrir la boite de dialogue, choisir un fichier excel dans un repertoire bien precis, sélectionner le fichier de la semaine en cours, copier son contenu dans un onglet défini du classeur ouvert.

Merci pour votre aide

Faroyo
 
Solution
Bonjour Faroyo,

Essayez cette macro :
VB:
Sub Copier()
Dim NomFichierSource As Variant
    ChDir ThisWorkbook.Path
    Do
        NomFichierSource = Application.GetOpenFilename("Fichiers .xls* (*.xls*), *.xls*")
        If NomFichierSource = False Then Exit Sub
    Loop While NomFichierSource = ThisWorkbook.FullName
    Application.ScreenUpdating = False
    With Workbooks.Open(NomFichierSource).Worksheets(1) 'ouvre le fichier
        .UsedRange = .UsedRange.Value 'supprime les formules
        .Cells.Copy ThisWorkbook.Worksheets(1).[A1] 'copier-coller
        .Parent.Close False
    End With
End Sub
A+

job75

XLDnaute Barbatruc
Bonjour Faroyo,

Essayez cette macro :
VB:
Sub Copier()
Dim NomFichierSource As Variant
    ChDir ThisWorkbook.Path
    Do
        NomFichierSource = Application.GetOpenFilename("Fichiers .xls* (*.xls*), *.xls*")
        If NomFichierSource = False Then Exit Sub
    Loop While NomFichierSource = ThisWorkbook.FullName
    Application.ScreenUpdating = False
    With Workbooks.Open(NomFichierSource).Worksheets(1) 'ouvre le fichier
        .UsedRange = .UsedRange.Value 'supprime les formules
        .Cells.Copy ThisWorkbook.Worksheets(1).[A1] 'copier-coller
        .Parent.Close False
    End With
End Sub
A+
 

Faroyo

XLDnaute Junior
Bonjour Faroyo,

Essayez cette macro :
VB:
Sub Copier()
Dim NomFichierSource As Variant
    ChDir ThisWorkbook.Path
    Do
        NomFichierSource = Application.GetOpenFilename("Fichiers .xls* (*.xls*), *.xls*")
        If NomFichierSource = False Then Exit Sub
    Loop While NomFichierSource = ThisWorkbook.FullName
    Application.ScreenUpdating = False
    With Workbooks.Open(NomFichierSource).Worksheets(1) 'ouvre le fichier
        .UsedRange = .UsedRange.Value 'supprime les formules
        .Cells.Copy ThisWorkbook.Worksheets(1).[A1] 'copier-coller
        .Parent.Close False
    End With
End Sub
A+
Testé ce matin. C'est top, ca fonctionne parfaitement.
Merci pour aide et votre temps
 

Discussions similaires

Statistiques des forums

Discussions
314 714
Messages
2 112 142
Membres
111 437
dernier inscrit
mimitorpez