Copier/coller d'un fichier à partir de la saisie du nom de ce fichier

[Holeshotman]

Bonjour à tous,

Je fais de nouveau appel à vous car je rencontre des difficultés pour faire ce que je souhaite...

Je dispose d'un fichier "Essai_LectureSeule" dans lequel se trouve le code. Sur ce fichier, il y a 3 feuilles. L'objectif étant de pouvoir saisir dans la cellule A1 de la feuille nommée "BASE" le nom d'un fichier se trouvant dans \\Vems-sft-02\Bureautique\DATA\Public\Indus_ScesTechniques_STP\STP\PROTOS\Outillages\Test\DATA\. Cela aurait pour but de l'ouvrir, de copier son unique feuille, de la coller sur la feuille nommée "ARCHIVE" de mon fichier "Essai_LectureSeule" et de le fermer.

Je pense qu'il faut au préalable faire une recherche du fichier en question qui se trouve dans le chemin indiqué.

Jusqu'à présent, ma macro marche, mais uniquement pour des noms de fichiers bien définis (utilisation du select case). J'aimerait que cela fonctionne quel que soit le nom du fichier.
Code actuel :

Sub CopieColleFichDifferent()

Dim NFich As String, Chemin As String, ContenuA1 As String
Chemin = "\\Vems-sft-02\Bureautique\DATA\Public\Indus_ScesTechniques_STP\STP\PROTOS\Outillages\Test\DATA\"
ContenuA1 = Worksheets("BASE").Range("A1").Value
Select Case ContenuA1

Case ("AAA")
NomFich = "AAA.xls"
Application.ScreenUpdating = False 'fige l'écran
Application.DisplayAlerts = False 'si le fichier est déjà ouvert
With Workbooks.Open(Chemin & NomFich, Local:=True)
  .Sheets(1).Cells.Copy ThisWorkbook.Sheets("ARCHIVE").[A1] 'copie toutes les cellules
  .Close 'ferme le fichier
End With

Case ("BBB")
NomFich = "BBB.xls"
Application.ScreenUpdating = False 'fige l'écran
Application.DisplayAlerts = False 'si le fichier est déjà ouvert
With Workbooks.Open(Chemin & NomFich, Local:=True)
  .Sheets(1).Cells.Copy ThisWorkbook.Sheets("ARCHIVE").[A1] 'copie toutes les cellules
  .Close 'ferme le fichier
End With

Case ("CCC")
NomFich = "CCC.xls"
Application.ScreenUpdating = False 'fige l'écran
Application.DisplayAlerts = False 'si le fichier est déjà ouvert
With Workbooks.Open(Chemin & NomFich, Local:=True)
  .Sheets(1).Cells.Copy ThisWorkbook.Sheets("ARCHIVE").[A1] 'copie toutes les cellules
  .Close 'ferme le fichier
End With

Case ("DDD")
NomFich = "DDD.xls"
Application.ScreenUpdating = False 'fige l'écran
Application.DisplayAlerts = False 'si le fichier est déjà ouvert
With Workbooks.Open(Chemin & NomFich, Local:=True)
  .Sheets(1).Cells.Copy ThisWorkbook.Sheets("ARCHIVE").[A1] 'copie toutes les cellules
  .Close 'ferme le fichier
End With

Case ("EEE")
NomFich = "EEE.xls"
Application.ScreenUpdating = False 'fige l'écran
Application.DisplayAlerts = False 'si le fichier est déjà ouvert
With Workbooks.Open(Chemin & NomFich, Local:=True)
  .Sheets(1).Cells.Copy ThisWorkbook.Sheets("ARCHIVE").[A1] 'copie toutes les cellules
  .Close 'ferme le fichier
End With

End Select

End Sub

J'espère que je suis suffisamment clair dans mes explications...
Je vous remercie par avance pour vos réponses !

Cordialement

 

[Holeshotman]

Re : Copier/coller d'un fichier à partir de la saisie du nom de ce fichier

Le top serait d'indiquer que le fichier n'existe pas si le nom entré en A1 n'est pas présent dans le dossier de recherche!
Yeahh !

 

[Pierrot93]

Re : Copier/coller d'un fichier à partir de la saisie du nom de ce fichier

Bonjour,

regarde ceci, si cela peut t'aider :

Dim chemin As String, fichier As String
chemin = Range("A1").Value 'chemin complet avec anti slash à la fin
fichier = Range("A2").Value 'fichier avec extension (.xls)
If Dir(chemin & fichier) <> "" Then Workbooks.Open chemin & fichier

bonne journée
@+