doudou08015
Messages postés lundi 6 mars 2017Date d'inscription
22 octobre 2017
Dernière intervention
-
22 oct. 2017 à 12:32 - Dernière réponse : Patrice337406799
Messages postés dimanche 13 juin 2010Date d'inscription
19 avril 2018
Dernière intervention
- 23 oct. 2017 à 09:27
Option Explicit
Sub Test()
Const adr$ = "A7:N100"
Dim wshSource As Worksheet
Dim wshCible As Worksheet
Dim rngCible As Range
Dim nomDossier As String
Dim nomFichier As String
Set wshCible = Workbooks("Gestion des reliquats.xlsm").Worksheets(1)
Set rngCible = wshCible.Cells(Rows.Count, "B").End(xlUp).Offset(1)
Set rngCible = rngCible.Resize(Range(adr).Rows.Count, Range(adr).Columns.Count)
nomDossier = "D:\moi\Gestion des reliquats\"
nomFichier = Dir(nomDossier & "TDOUAY_QSYSPRT_2017*.txt")
If nomFichier <> "" Then
Workbooks.OpenText Filename:=nomDossier & nomFichier, Origin:=xlWindows, StartRow:=1, _
DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(13, 1), Array(22, 1), Array(49, 1), _
Array(54, 1), Array(63, 1), Array(66, 1), Array(81, 1), Array(90, 1), Array(110, 1), _
Array(119, 1), Array(126, 1), Array(135, 1), Array(137, 1)), TrailingMinusNumbers:=True
Set wshSource = ActiveSheet
rngCible.Value = wshSource.Range(adr).Value
wshSource.Parent.Close False
rngCible.Cells(1, 1).Offset(0, -1).Formula = Date
End If
End S
Patrice337406799
Messages postés dimanche 13 juin 2010Date d'inscription
19 avril 2018
Dernière intervention
>
doudou08015
Messages postés lundi 6 mars 2017Date d'inscription
22 octobre 2017
Dernière intervention -22 oct. 2017 à 19:52
Non.
Ta macro de départ est très mal écrite, il faut absolument évite les Select, Activate, selection, ...
Mais je commenter le code :
Option Explicit
Sub xxx()
Const adr$ = "A7:N100"
Dim wshSource As Worksheet
Dim wshCible As Worksheet
Dim rngCible As Range
Dim nomDossier As String
Dim nomFichier As String
'Définir la feuille cible
Set wshCible = Workbooks("Gestion des reliquats.xlsm").Worksheets(1)
'Définir la première cellule libre de la colonne B de la cible
Set rngCible = wshCible.Cells(Rows.Count, "B").End(xlUp).Offset(1)
'Définir la plage cible (qui recevra les valeurs)
Set rngCible = rngCible.Resize(Range(adr).Rows.Count, Range(adr).Columns.Count)
'Définir du nom du dossier
nomDossier = "D:\moi\Gestion des reliquats\"
'Checher dans le dossier, le nom du fichier qui commence par ...
nomFichier = Dir(nomDossier & "TDOUAY_QSYSPRT_2017*.txt")
If nomFichier <> "" Then
'S'il existe un fichier correspondant, l'ouvrir
Workbooks.OpenText Filename:=nomDossier & nomFichier, Origin:=xlWindows, StartRow:=1, _
DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(13, 1), Array(22, 1), Array(49, 1), _
Array(54, 1), Array(63, 1), Array(66, 1), Array(81, 1), Array(90, 1), Array(110, 1), _
Array(119, 1), Array(126, 1), Array(135, 1), Array(137, 1)), TrailingMinusNumbers:=True
'Definir la feuille source (qui contient les valeurs à copier)
Set wshSource = ActiveSheet
'Copier les valeurs de la source vers la cible
rngCible.Value = wshSource.Range(adr).Value
'Fermer le fichier source
wshSource.Parent.Close False
'Mettre la date colonne A, sur la première ligne des données copiées
rngCible.Cells(1, 1).Offset(0, -1).Formula = Date
End If
End Sub
doudou08015
Messages postés lundi 6 mars 2017Date d'inscription
22 octobre 2017
Dernière intervention
>
Patrice337406799
Messages postés dimanche 13 juin 2010Date d'inscription
19 avril 2018
Dernière intervention -22 oct. 2017 à 20:09
votre fichier fonctionne a merveille.
c'est juste la conversion du fichier TXT qui ne corespond pas a ce que j'avais au depart.
Patrice337406799
Messages postés dimanche 13 juin 2010Date d'inscription
19 avril 2018
Dernière intervention
>
doudou08015
Messages postés lundi 6 mars 2017Date d'inscription
22 octobre 2017
Dernière intervention -23 oct. 2017 à 09:27
je ne m'y retrouve pas
serait il possible d’intégré a ma macro de depart :
votre code pour le choix du fichier:
nomDossier = "D:\moi\Gestion des reliquats\"
nomFichier = Dir(nomDossier & "TDOUAY_QSYSPRT_2017*.txt")
votre code pour la date:
rngCible.Cells(1, 1).Offset(0, -1).Formula = Date ?
cordialement votre
Ta macro de départ est très mal écrite, il faut absolument évite les Select, Activate, selection, ...
Mais je commenter le code :
Option Explicit Sub xxx() Const adr$ = "A7:N100" Dim wshSource As Worksheet Dim wshCible As Worksheet Dim rngCible As Range Dim nomDossier As String Dim nomFichier As String 'Définir la feuille cible Set wshCible = Workbooks("Gestion des reliquats.xlsm").Worksheets(1) 'Définir la première cellule libre de la colonne B de la cible Set rngCible = wshCible.Cells(Rows.Count, "B").End(xlUp).Offset(1) 'Définir la plage cible (qui recevra les valeurs) Set rngCible = rngCible.Resize(Range(adr).Rows.Count, Range(adr).Columns.Count) 'Définir du nom du dossier nomDossier = "D:\moi\Gestion des reliquats\" 'Checher dans le dossier, le nom du fichier qui commence par ... nomFichier = Dir(nomDossier & "TDOUAY_QSYSPRT_2017*.txt") If nomFichier <> "" Then 'S'il existe un fichier correspondant, l'ouvrir Workbooks.OpenText Filename:=nomDossier & nomFichier, Origin:=xlWindows, StartRow:=1, _ DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(13, 1), Array(22, 1), Array(49, 1), _ Array(54, 1), Array(63, 1), Array(66, 1), Array(81, 1), Array(90, 1), Array(110, 1), _ Array(119, 1), Array(126, 1), Array(135, 1), Array(137, 1)), TrailingMinusNumbers:=True 'Definir la feuille source (qui contient les valeurs à copier) Set wshSource = ActiveSheet 'Copier les valeurs de la source vers la cible rngCible.Value = wshSource.Range(adr).Value 'Fermer le fichier source wshSource.Parent.Close False 'Mettre la date colonne A, sur la première ligne des données copiées rngCible.Cells(1, 1).Offset(0, -1).Formula = Date End If End Subc'est juste la conversion du fichier TXT qui ne corespond pas a ce que j'avais au depart.
Cordialement
Patrice