Copie sur une page précise
Bonjour,
Dans le cadre de mon travail j'ai un fichier excel que j'essaie d'améliorer cependant je suis bloqué.La fichier contient une 30 de page qui ont chacune une zone ou l'on doit y rentrer du texte (testHK.txt) et pour automatiser la tache j'ai penser à un bouton qui ferait appel à une macro qui copierait le fichier voulu et le collerais dans une zone de la feuille ou se trouve le bouton sur lequel on à cliqué .Cependant je n'ai pas réussi à faire ça j'ai juste réussi à faire en sorte que ma macro copie et colle dans la zone voulue mais elle le fait sur la feuille 1.Je ne peux pas vous fournir le fichier de base mais j'ai recrée un fichier avec la macro et 4 pages types .Le but est que lorsqu'on est en feuille 3 et que l'on appuie sur le bouton elle copie les donnés sur la plage de cette feuille .J'ai tenter d'utiliser la méthode activesheet pour copier les valeur dans la feuille ou on se trouve mais je n'ai pas réussi et elle me retournais une erreur
Voici le code :
Sub import_donnees()
Dim fich_txt As String
Dim fich_source As String
fich_source = ActiveWorkbook.Name
'effacement des données présentes
ActiveSheet.Range("L8:L" & ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row).ClearContents
ChDir ActiveWorkbook.Path
'demande a l'utilisateur de choisir un fichier
fich_txt = Application.GetOpenFilename("Tous les fichiers (*.*),*.*")
'ouverture du fichier txt
Workbooks.OpenText Filename:=fich_txt, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, Local:=True, Semicolon:=True
'copie des lignes
ActiveWorkbook.Sheets(1).Range("A1:A" & ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row).Copy 'Workbooks(fich_source).Feuil1.Range("A1")
'collage spéciale des valeurs
Workbooks(fich_source).Sheets(1).[L8].PasteSpecial xlValues
'fermeture du fichier
Application.DisplayAlerts = False
ActiveWorkbook.Close False
Application.DisplayAlerts = True
'tri des données
Range("L8:L221").Select
Selection.TextToColumns Destination:=Range("L8"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(16, 1), Array(28, 1), Array(40, 1), Array(51, 1), _
Array(71, 1), Array(95, 1), Array(106, 1), Array(118, 1), Array(124, 1), Array(126, 1)), _
TrailingMinusNumbers:=True
End SubTentative avec activeSheet :
Sub import_donnees()
Dim fich_txt As String
Dim fich_source As String
fich_source = ActiveWorkbook.Name
'effacement des données présentes
ActiveSheet.Range("L8:L" & ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row).ClearContents
ChDir ActiveWorkbook.Path
'demande a l'utilisateur de choisir un fichier
fich_txt = Application.GetOpenFilename("Tous les fichiers (*.*),*.*")
'ouverture du fichier txt
Workbooks.OpenText Filename:=fich_txt, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, Local:=True, Semicolon:=True
'copie des lignes
ActiveWorkbook.Sheets(1).Range("A1:A" & ActiveWorkbook.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row).Copy 'Workbooks(fich_source).Feuil1.Range("A1")
'collage spéciale des valeurs
ActiveSheet.[L8].PasteSpecial xlValues
'fermeture du fichier
Application.DisplayAlerts = False
ActiveWorkbook.Close False
Application.DisplayAlerts = True
'tri des données
Range("L8:L221").Select
Selection.TextToColumns Destination:=Range("L8"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(16, 1), Array(28, 1), Array(40, 1), Array(51, 1), _
Array(71, 1), Array(95, 1), Array(106, 1), Array(118, 1), Array(124, 1), Array(126, 1)), _
TrailingMinusNumbers:=True
End SubMerci pour votre aide
Cordialement
Nelson
Bonjour,
Il faut rendre paramétrique votre procédure Import-donnees.
Bonjour,
Merci beaucoup ! Ça fonctionne parfaitement !Je n'avais pas du tout pensé à ajouter en paramètre la feuille.
Encore merci pour votre aide bonne journée
Nelson