Bonjour,
Merci de ta réponse mais elle est un peu trop 'technique' pour moi désolé
Je n'ai pas précisé je suis novice en VBA.
Le nom de mon fichier sera différent a chaque fois suivant le contenu de la cellule C14
j'ai trouvé un contournement voici mon code :
Public Sub Transformation()
Dim wbSource, wbFichierUsager As Workbook
Dim strFileName As String
Dim intChoice As Integer 'Déclarer les variables de base
Set wbFichierUsager = ThisWorkbook
' On va appeler une application de MS Office afin de chercher et d’ouvrir le bon fichier
' Avec la commande qui suit, on indique que nous ne voulons qu’un seul fichier
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
' On affiche l’écran de dialogue de MS Office
intChoice = Application.FileDialog(msoFileDialogOpen).Show
' On s’assure que l’usager a fait un choix
If intChoice <> 0 Then
' On récupère le nom complet du fichier
strFileName = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
Workbooks.Open strFileName
Set wbSource = ActiveWorkbook
' Sinon, on arrête tout en notifiant l’usager
Else
' S’il n’y a pas de fichier, on quitte sans rien faire
MsgBox "La procédure est annulée car aucun fichier n’a été entré."
Exit Sub
End If
' Ici, on insère le code qui applique les changements voulus au fichier ouvert, qui sera ensuite refermé
' Suppression des colonnes non souhaitée
Range(Range("B5"), Range("C5").End(xlDown)).Select
Selection.Delete Shift:=xlToLeft
Range(Range("C5"), Range("C5").End(xlDown)).Select
Selection.Delete Shift:=xlToLeft
Range(Range("F5"), Range("F5").End(xlDown)).Select
Selection.Delete Shift:=xlToLeft
Range(Range("H5"), Range("H5").End(xlDown)).Select
Selection.Delete Shift:=xlToLeft
Range(Range("I5"), Range("K5").End(xlDown)).Select
Selection.Delete Shift:=xlToLeft
' Creation du tableau
Range(Range("A5"), Range("H5").End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
' FicOri = ActiveSheet.Range(Range("A5"), Range("H5").End(xlDown))
ShtToCopy = "Feuil1"
FicWip = "Z:\WIP.xlsx"
' Copie de la selection du tableau
Sheets("Feuil1").Range(Range("A5"), Range("H5").End(xlDown)).Copy
' Ouverture du modele de document et collage de la selection
Workbooks.Open (FicWip)
Sheets(ShtToCopy).Select
ActiveSheet.Paste Range("A13")
'Sauvegarde du document sous la forme Client_Date
With ActiveWorkbook
.SaveAs Filename:=Range("C14") & "_" & Format(Now, "dd-mm-yy")
.Close
End With
'Fermeture des classeurs
ActiveWorkbook.Close savechanges:=False
Application.DisplayAlerts = False
Application.Quit
End Sub
Je pense qu'il y a moyen de faire plus 'propre' mais pour le moment cela fonctionne.
Cordialement,
Laurent