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 Sub

Tentative 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 Sub

Merci pour votre aide
Cordialement
Nelson

6testhk.txt (3.95 Ko)

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

Rechercher des sujets similaires à "copie page precise"