XL 2016 VBA ouvrir un fichier dont le nom change

[semir]

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)

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. ?

 

[CHALET53]

Bonjour

Si ta variable est dans la cellule C1 du fichier Destination
essaie ceci dans ta macro :
mavariable= range("C1").value
Workbooks.Open ("B:\Chemin\" & mavariable & " - Fichier source.xlsx")

a+

 

[Dranreb]

Dans ce classeur, un UFmWbk muni d'une méthode Classeur renvoyant un objet Workbook à partir d'une identification partielle.

 

[semir]

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]

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)

 

[Dranreb]

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 :

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]

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]

Bonjour semir, CHALET53, Bernard, zebanx,

Depuis le temps je ne comprends pas que personne n'ait proposé une solution de ce genre, archi classique :

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+

 

[Dranreb]

Bonjour.
Ben c'est en quelque sorte ce que j'ai proposé avec, dans un UserForm qui ne s'affiche pas forcément, une gestion toute faites des erreurs et du processus permettant de lever une ambiguïté

 

[job75]

Re,

Avec une ComboBox dans un UserForm c'est mieux que la MsgBox :

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 :

Private Sub ComboBox1_Change()
With ComboBox1
    If .ListIndex = -1 Then .Value = "": Exit Sub
    fichier = .Value
    Unload Me
End With
End Sub

Fichier (2)

A+

 

[job75]

Re,

Autre solution classique si l'on veut copier seulement les valeurs, une formule de liaison (matricielle) :

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+

 

[job75]

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 :

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+