VBA ma macro ne sait pas copier/coller correctement
Bonjour à toutes et à tous,
J'ai crée une macro permettant de rassembler dans un nouveau classeur des données provenant d'autres classeurs, afin d'effectuer des traitements par la suite.
Problème : Là où les dates sont au bon format dans le fichier d'origine, la copie est défectueuse pour certaines cases. Certaines sont copiées correctement au format DATE dans la destination, d'autres sont recopiées au format STANDARD avec pleins d'espaces inutiles à la fin!!!
Vous verrez dans la macro jointe, que j'ai tenté tout ce que j'ai trouvé pour reconvertir correctement les dates, sans y parvenir...
Un fichier test contenant les valeurs à extraire est également joint.
Sub E3_BACN_FACTUR()
Dim fso As Object 'Système de fichiers
Dim rep As Object 'Répertoire
Dim cfr As Object 'Collection de fichiers du répertoire
Dim fic As Object 'Fichier (élément de la collection cfr)
Dim wbk As Workbook 'Classeur
Dim res As Workbook 'Classeur resultat
Dim rng As Range 'Plage de cellules
Dim dst As Range 'Cellule de destination
Dim pth As String 'Chemin du répertoire
Dim etc As Boolean 'En tête copié
Const lig$ = "1" 'Adresse de la première ligne des tableaux à copier
Const col$ = "C" 'Adresse de la colonne à tester
Const titre As Integer = 5
Dim datelim As Date
datelim = InputBox("Inscrivez la date limite", "Action requise", Date)
'------------------------------------------1------------------------------------------
' Définir le répertoire à lire
pth = "C:\Users\ISSOU\Desktop\TEST"
' Créer le fichier résultat
Set res = Workbooks.Add(xlWBATWorksheet)
Set dst = res.Worksheets(1).Range("A1")
i = 1
' Lecture du répertoire
Set fso = CreateObject("Scripting.FileSystemObject")
Set rep = fso.GetFolder(pth)[attachment=0]TEST.xls[/attachment]
Set cfr = rep.Files
' Contrôler chaque fichier du répertoire
For Each fic In cfr
On Error Resume Next
' - Vérifier s'il s'agit d'un fichier Excel...
If StrComp(fso.GetExtensionName(fic.Name), "xls", vbTextCompare) = 0 And fic.Name Like "*TEST*" Then
' ... dans l'affirmative, ouvrir le fichier et mettre à jour les liaisons
Set wbk = Workbooks.Open(Filename:=pth & "\" & fic.Name, UpdateLinks:=xlUpdateLinksAlways)
' Définir les lignes à copier
With wbk.Worksheets(1)
Set rng = .Rows(lig & ":" & .Cells(.Rows.Count, col).End(xlUp).Row)
End With
' Copier les lignes entières
rng.Copy
dst.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
' Destination suivante
i = i + 1
Set wrs = res.Worksheets.Add
Set dst = res.Worksheets("Feuil" & i).Range("A1")
' Fermer le fichier sans le modifier
wbk.Close False
End If
Next fic
Application.DisplayAlerts = False
' Pour chaque feuille dans le nouveau classeur...
For Each wrs In res.Worksheets
' ...Si elle est vide...
If Cells.Find("*") Is Nothing Then
' ...La supprimer
wrs.Delete
End If
Next wrs
Application.DisplayAlerts = True
res.Worksheets("Feuil1").Name = "FACT LP"
res.Worksheets("Feuil2").Name = "TOT LP"
Set wsh1 = res.Worksheets("FACT LP")
Set wsh2 = res.Worksheets("TOT LP")
With wsh1
Lastlig = .Cells(Rows.Count, col).End(xlUp).Row
Lastcol = .Cells(titre, Columns.Count).End(xlToLeft).Column
Application.Calculation = xlCalculationManual
Application.Calculation = xlCalculationAutomatic
For i = titre + 1 To Lastlig
Cells(i, 6).Value = Trim(Cells(i, 6).Value)
Cells(i, 6).Calculate
Next i
Range(Cells(titre + 1, 6), Cells(Lastlig, 6)).TextToColumns , xlFixedWidth, Array(0, 3)
For i = Lastlig To titre Step -1
If Cells(i, 6).Value <= datelim Then
Cells(i, 6).EntireRow.Delete
End If
Next i
End With
res.SaveAs "C:\users\ISSOU\Desktop\Facturation LP.xls"
Si l'un(e) de vous a une solution, merci d'avance.
Bonjour,
je n'ai jamais encore trouvé ce collage spécial regroupé sur une seule ligne :
dst.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
dst.PasteSpecial Paste:=xlPasteValues
dst.PasteSpecial Paste:=xlPasteFormatsMise à jour :
Donc avec les fichiers d'origines, ça foire, mais quand je fais avec un fichier test (mêmes données, mais anonymisé...), ça réussit...
C'est à n'y rien comprendre TONNERRE DE BREST!!!
Bonjour,
je n'ai jamais encore trouvé ce collage spécial regroupé sur une seule ligne :
dst.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
dst.PasteSpecial Paste:=xlPasteValues dst.PasteSpecial Paste:=xlPasteFormats
Bonjour et merci à toi pour ta réponse.
C'est Excel qui me l'a suggéré quand j'écrivais la macro
EDIT : Pour le coup c'est encore pire, ça me recopie des nombre
Bonjour,
je n'ai jamais encore trouvé ce collage spécial regroupé sur une seule ligne :
dst.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
dst.PasteSpecial Paste:=xlPasteValues dst.PasteSpecial Paste:=xlPasteFormatsBonjour et merci à toi pour ta réponse.
C'est Excel qui me l'a suggéré quand j'écrivais la macro
Version 2016 ?
Essaies quand même sur deux lignes car chez moi le format des dates est correctement copié.
Bonjour,
je n'ai jamais encore trouvé ce collage spécial regroupé sur une seule ligne :
dst.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
dst.PasteSpecial Paste:=xlPasteValues dst.PasteSpecial Paste:=xlPasteFormatsBonjour et merci à toi pour ta réponse.
C'est Excel qui me l'a suggéré quand j'écrivais la macro
Version 2016 ?
Essaies quand même sur deux lignes car chez moi le format des dates est correctement copié.
Il me semble que c'est 2013.
Bref, en deux lignes ne fonctionne pas (me recopie des nombres au lieu de dates.
Toutefois il y a du nouveau : avec un fichier test anonymisé placé dans un autre répertoire (en l'occurence, un qui se trouve sur le bureau), la macro fais son taf correctement. Par contre avec les classeurs d'origines, ça foire... Je n'y comprends rien.
Bonjour et merci à toi pour ta réponse.
C'est Excel qui me l'a suggéré quand j'écrivais la macro
Version 2016 ?
Essaies quand même sur deux lignes car chez moi le format des dates est correctement copié.
Il me semble que c'est 2013.
Bref, en deux lignes ne fonctionne pas (me recopie des nombres au lieu de dates.
Toutefois il y a du nouveau : avec un fichier test anonymisé placé dans un autre répertoire (en l'occurence, un qui se trouve sur le bureau), la macro fais son taf correctement. Par contre avec les classeurs d'origines, ça foire... Je n'y comprends rien.
J'ai réussi à cibler la source du problème grâce au débogueur : quand la macro ouvre le fichier d'origine, je vois qu'elle change le format de certaines dates en STANDARD et rajoute les espaces à l'ouverture (alors que sur le fichier d'origine elles sont normales et au format DATE).
La seule différence notable entre le fichier d'origine et le fichier TEST est que le fichier TEST a été enregistré au format .xls, alors que le fichier d'origine est extrait d'un PGI, au format .xls mais considéré comme du texte ou un truc comme ça (quand je l'ouvre, toujours un message d'excel).
Si le problème vient de là, comment le résoudre ?
Re,
Quel est le message sur le fichier d'origine à l'ouverture ?
Au pire tu l'ouvres une fois ensuite tu réalises un fichier enregistrer sous et tu selectionnes le format :
-classeur Excel 97 - 2003 (*.xls)
et si toujours même message alors sous format Classeur Excel (*.xlsx)
"Le format et l'extension du fichier de "MACHIN.xls" ne correspondent pas. Le fichier peut présenter un risque ou avoir été endommagé bla bla bla"
Oui je comprends, mais j'aimerais automatiser ça car c'est chiant à chaque fois d'ouvrir, enregistrer sous, etc. ... Si vraiment il n'y a pas moyen de rajouter 2-3 lignes pour enregistrer tel ou tel format, je le ferais peut-être.
Sinon une autre idée mais infructueuse pour le moment : je vire les espaces avec Trim, et après j'essaie de mettre en date avec TextToColumns Array(0,3) mais ça reste en standard (par contre Excel reconnaît maintenant qu'il y a une erreur avec des cellules qui devraient être en format date).
Si quelqu'un connaîtrait une solution ? Merci!
Le fichier Machin.xls il vient d'un programme qui le modifie ou l'exporte à chaque fois ?
L'extension.xls c'est le programme qui l'a indiqué ou tu l'as changés manuellement ?
à l'origine ce n'était pas un *.csv ?
si la mise à jour ne se fait plus que par tes macros alors je penses que tu peux faire un seul est unique enregistrer sous en indiquant le bon format pour ne plus avoir de message d'erreur à l'ouverture.
En fait le PGI l'exporte sur demande sur notre boite mail au format .xls, mais je ne sais pas pourquoi (je ne suis pas un grand connaisseur), à chaque fois il faut enregistrer sous, car il est considéré comme un .txt il me semble, mais pas comme un .xls.
Du coup j'ai rajouté un morceau de code :
ActiveWorkbook.SaveAs Filename:=pth & "\" & fic.Name & ".xls", FileFormat:= _
xlExcel8, CreateBackup:=False
Par contre ça ne résout pas mon problème de date, il faudrait que je trouve un moyen de forcer le format date à l'ouverture du fichier.
Le TextToColumns que ce soit avec Array(0,3) ou Array(1,4) ne fonctionne pas. Pareil pour .NumberFormat = "dd/mm/yyyy".
On peut avoir une copie avec deux lignes de ce "Faux" fichier excel ? en remplaçant les infos sensibles.
C'est pour voir si le contenu des cellules sont de vrai espaces ou des caractères non gérés.
Oui aucun problème.
Par contre sur ce "faux", tel quel, les dates sont au bon format, par contre quand j'ordonne à ma macro de l'ouvrir pour tout recopier, quand elle l'ouvre certaines dates (pas toutes) perdent leur format et c'est la foire à la saucisse.
Oui aucun problème.
Par contre sur ce "faux", tel quel, les dates sont au bon format, par contre quand j'ordonne à ma macro de l'ouvrir pour tout recopier, quand elle l'ouvre certaines dates (pas toutes) perdent leur format et c'est la foire à la saucisse.mpe_agee_003_4.xls
je vais réfléchir à ce faux format excel d'importation.... peut être en passant par une procédure pour le retransformer
en fichier csv ou txt afin d'avoir les options de convertion avant de recommencer l'importation ?
dans le résultat même la première date n'est plus reconnu. encore plus bizarre je vais réfléchir à ce faux format excel d'importation.... peut être en passant par une procédure pour le retransformer
en fichier csv ou txt afin d'avoir les options de convertion avant de recommencer l'importation ?
Alors j'ai réfléchis à quelques idées, notamment celles de ré-enregistrer le fichier en .xls, le problème est que je ne sais pas le faire sans ouvrir le classeur (je crois même que c'est impossible sans), et donc ça modifie certaines dates.
Par contre qu'entends-tu par "retransformer" en csv ou txt ?
changer l'extention du fichier que l'on t'envoi pour passer de xls à txt. ou csv
quand tu ouvres un fichier txt avec excel tu as en sélectionnant la première colonne les options actives pour
convertir dans le menu ( colonne par colonne ) tu peux donc préciser quelles colonnes sont des dates
Réponse tardive je sais,
Merci à toi pour ton aide!