Bonjour,
Voici une solution possible.
Private Sub BTN1_Click()
Dim CheminFichier As String
Dim nomFichier As String
Dim nomFichierSansExtension As String
Dim caracteres As String
Dim FeuilleSource As Worksheet
Dim TableauDestination As ListObject
Dim DerniereLigneSource As Long
' Désactive la mise à jour de l'écran pour améliorer les performances
Application.ScreenUpdating = False
' Ouvre la boîte de dialogue pour sélectionner le fichier source
With Application.FileDialog(msoFileDialogFilePicker)
If .Show = -1 Then ' Si l'utilisateur clique sur Ouvrir
CheminFichier = .SelectedItems(1)
Else
Exit Sub ' L'utilisateur a annulé la sélection
End If
End With
' Extraire le nom du fichier sans le chemin d'accès
nomFichier = Right(CheminFichier, Len(CheminFichier) - InStrRev(CheminFichier, Application.PathSeparator))
' Supprimez l'extension du nom de fichier
nomFichierSansExtension = Left(nomFichier, InStrRev(nomFichier, ".") - 1)
' Extrait les 8 caractères précédant l'extension
If Len(nomFichierSansExtension) >= 8 Then
caracteres = Right(nomFichierSansExtension, 8)
If Not IsNumeric(Left(cracteres, 1)) Then caracteres = Right(nomFichierSansExtension, 7)
End If
' Affichez les 6 caractères dans la cellule A1
Range("F26") = caracteres
' Définit la feuille de calcul source
Set FeuilleSource = Workbooks.Open(CheminFichier).Worksheets(1) ' Vous pouvez ajuster le numéro de la feuille si nécessaire
' Définit le tableau de destination
On Error Resume Next
Set TableauDestination = ThisWorkbook.Sheets("Calcul").ListObjects("TBL_HSTS") ' Assurez-vous que la feuille et le tableau sont correctement nommés
On Error GoTo 0
' Vérifie si le tableau de destination existe
If Not TableauDestination Is Nothing Then
' Trouve la dernière ligne de la colonne A dans la feuille source
DerniereLigneSource = FeuilleSource.Cells(FeuilleSource.Rows.Count, "A").End(xlUp).Row
' Copie les données de la colonne A, B, C et D de la feuille source vers le tableau de destination
If DerniereLigneSource >= 2 Then ' Vérifie s'il y a au moins 1 ligne de données (à partir de la ligne 2 de la source)
TableauDestination.ListRows.Add
FeuilleSource.Range("A2:C" & DerniereLigneSource).Copy TableauDestination.ListColumns(1).DataBodyRange
MsgBox "Données copiées avec succès!", vbInformation
Else
MsgBox "La feuille source ne contient pas de données à copier.", vbExclamation
End If
Else
MsgBox "Le tableau de destination n'a pas été trouvé dans la feuille 'Calcul'.", vbExclamation
End If
' Ferme le fichier source sans enregistrer les modifications
Workbooks.Open(CheminFichier).Close SaveChanges:=False
End Sub