XL 2016 VBA ouvrir un fichier dont le nom change

semir

XLDnaute Nouveau
Bonsoir tous le monde,

je souhaite modifier une partie du début de ma macro. je dois ouvrir un fichier Excel et copier coller une feuille de calcul dans un autre document. Cependant je viens de m'apercevoir que chaque mois le nom du fichier change.
Mon code est plutot basique. Je sais que je dois utiliser une variable afin de stocker le nom du fichier et j'ai tenter d'utiliser les methodes dans certains anciens post ayant la meme demande mais je n'ai pas reussis á mettre en place une solution pour mon cas present :

(pour etre precis le chemin du fichier source ne change jamais et la macro se situe dans destination)

VB:
Sub Transfert ()


' ouvrir le fichier source
Application.DisplayAlerts = False
Workbooks.Open ("B:\Chemin\****** - Fichier source.xlsx")
Application.DisplayAlerts = True
Sheets("Source").Select

'copier les donnés dans destination
Workbooks("201809 - Fichier source.xlsx").Sheets("Source").Range("A1:BI60000").Copy Workbooks("Destination.xlsm").Worksheets("Sheet1").Range("A1")

'Fermer fichier source
Application.DisplayAlerts = False
Workbooks("201810 - Fichier source").Close SaveChanges:=False
Application.DisplayAlerts = True

End sub

Pourriez vous m'aider svp. ?
 

semir

XLDnaute Nouveau
Bonjour Chalet53 , Dranreb,

Merci pour vos reponse et votre Aide, je n'ai pas encore cree de variable pour l'ouverture du fichier car je ne sais pas comment m'y prendre.
Le fichier Joint est tres interessant meme si je ne comprend pas la totalité je comprend la logique un peu.

Quel serais le moyen le plus simple pour mon cas present ? Il s'agit simplement du debut du nom du fichier qui va changer.

merci
 

Dranreb

XLDnaute Barbatruc
Il suffit de mettre As Workbook derrière un nom de variable locale dans une Dim ou globale dans une Private ou Public.
Pour le reste la démo va jusqu'à afficher les bouts de codes qu'elle utilise.
(C'est la Worksheet_SelectionChange de WshTestUFmWbk)
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Bonsoir.
Je suppose que depuis le temps vous avez résolu votre problème et que vous avez pu vous rendre compte de la simplicité du code, après installation de l'UFmWbk par glisser déplacer de son nom vers votre projet :
VB:
Sub Transfert()
Dim Wbk As Workbook
Set Wbk = UFmWbk.Classeur("B:\Chemin\* - Fichier source.xlsx")
If Wbk Is Nothing Then Exit Sub
Wbk.Worksheets("Source").Range("A1:BI60000").Copy ThisWorkbook.Worksheets("Sheet1").Range("A1")
Wbk.Close SaveChanges:=False
End Sub
 

zebanx

XLDnaute Accro
Bonjour à tous, le forum

S'il s'agit à chaque fois d'un unique fichier, pourquoi ne pas faire appel à une inputbox pour définir une partie de la variable correspondant au fichier à ouvrir (chemin\dateref - fichiersource.xlsm) ?
dateref = InputBox("Entrez la période de référence SVP" & vbCrLf _
& "(Format type : AAAAMM)", "Fichier de référence à ouvrir")

@+
 

job75

XLDnaute Barbatruc
Bonjour semir, CHALET53, Bernard, zebanx,

Depuis le temps je ne comprends pas que personne n'ait proposé une solution de ce genre, archi classique :
Code:
Sub CopierFichierSource()
Dim chemin$, fichier$
'chemin = "B:\Chemin\" 'à adapter
chemin = ThisWorkbook.Path & "\" 'pour tester
fichier = Dir(chemin & "* - Fichier source.xlsx") '1er fichier du dossier
Application.DisplayAlerts = False 'si le fichier est déjà ouvert
While fichier <> ""
    Application.ScreenUpdating = True
    If MsgBox("Voulez-vous copier le fichier '" & fichier & "' ?", 4) = 6 Then
        Application.ScreenUpdating = False
        Workbooks.Open chemin & fichier
        ActiveWorkbook.Sheets("Source").[A1:BI60000].Copy ThisWorkbook.Sheets("Sheet1").[A1]
        ActiveWorkbook.Close False
    End If
    fichier = Dir 'fichier suivant
Wend
End Sub
La MsgBox est nécessaire car plusieurs fichiers peuvent être trouvés.

Fichiers joints, téléchargez-les dans le même répertoire (le bureau).

A+
 

Pièces jointes

  • Destination(1).xlsm
    20.8 KB · Affichages: 39
  • 20181121 - Fichier source.xlsx
    14 KB · Affichages: 32
  • 20181122 - Fichier source.xlsx
    14.1 KB · Affichages: 28

job75

XLDnaute Barbatruc
Re,

Avec une ComboBox dans un UserForm c'est mieux que la MsgBox :
Code:
Public fichier$ 'mémorise la variable

Sub CopierFichierSource()
Dim chemin$, n
'chemin = "B:\Chemin\" 'à adapter
chemin = ThisWorkbook.Path & "\" 'pour tester
fichier = Dir(chemin & "* - Fichier source.xlsx") '1er fichier du dossier
While fichier <> ""
    n = n + 1
    UserForm1.ComboBox1.AddItem fichier
    fichier = Dir
Wend
If n = 0 Then Exit Sub
fichier = ""
UserForm1.Show
If fichier = "" Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier est déjà ouvert
Workbooks.Open chemin & fichier
ActiveWorkbook.Sheets("Source").[A1:BI60000].Copy ThisWorkbook.Sheets("Sheet1").[A1]
ActiveWorkbook.Close False
End Sub
Le code de l'UserForm :
Code:
Private Sub ComboBox1_Change()
With ComboBox1
    If .ListIndex = -1 Then .Value = "": Exit Sub
    fichier = .Value
    Unload Me
End With
End Sub
Fichier (2)

A+
 

Pièces jointes

  • Destination(2).xlsm
    24.2 KB · Affichages: 24

job75

XLDnaute Barbatruc
Re,

Autre solution classique si l'on veut copier seulement les valeurs, une formule de liaison (matricielle) :
Code:
Application.ScreenUpdating = False
With Sheets("Sheet1").[A1:BI60000]
    .FormulaArray = "='" & chemin & "[" & fichier & "]Source'!A1:BI60000" 'formule de liaison matricielle
    .Value = .Value 'supprime la formule
    .Replace 0, "", xlWhole 'efface les valeurs zéro
    With .Parent.UsedRange: End With 'actualise les barres de défilement
End With
Cela évite d'ouvrir le fichier mais sur une grande plage comme ici c'est bien plus long.

Fichier (3).

A+
 

Pièces jointes

  • Destination(3).xlsm
    24.7 KB · Affichages: 23

job75

XLDnaute Barbatruc
Re,

Durées d'exécution chez moi après choix du fichier :

- fichier (2) => 5 secondes

- fichier (3) => 65 secondes dont 50 secondes pour l'effacement des zéros.

La durée passe à 12 secondes pour ce fichier (3 bis) qui utilise un tableau VBA :
Code:
Application.ScreenUpdating = False
With Sheets("Sheet1").[A1:BI60000]
    .FormulaArray = "='" & chemin & "[" & fichier & "]Source'!A1:BI60000" 'formule de liaison matricielle
    tablo = .Value 'matrice, plus rapide
    ncol = UBound(tablo, 2)
    For i = 1 To UBound(tablo)
        For j = 1 To ncol
            If tablo(i, j) = 0 Then tablo(i, j) = ""
    Next j, i
    .Value = tablo 'restitution des valeurs
    With .Parent.UsedRange: End With 'actualise les barres de défilement
End With
A+
 

Pièces jointes

  • Destination(3 bis).xlsm
    25.6 KB · Affichages: 23

Discussions similaires

Réponses
3
Affichages
306

Statistiques des forums

Discussions
311 735
Messages
2 082 024
Membres
101 873
dernier inscrit
excellllll