Transcription de données xls8

Fermé
toopey77 - 21 janv. 2015 à 10:55
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 - 21 janv. 2015 à 12:14
Bonjour à tous,

Me voilà un peu bloqué face à une situation étrange...
j'ai créer une macros qui me permet de concaténer plusieurs fichiers à l'intérieur d'un seul.

seul problème... les fichiers à concaténer sont des fichiers XLS8.
et au moment de l'ouverture sous excel il y a une conversion des données...

je perd un certain nombre de virgule dans les chiffres que je tente de concaténer...

en revanche si j'ouvre le fichier XLS8 tout seul, les données sont juste...

Je pense que le problème semble venir du faite que j'ouvre mon fichier xls8 dans la même fenêtre excel que ma macro (normal pour qu'elle s'applique)

alors que si je double clic sur mon fichier xls8 les données sont justes mais dans une fenêtre différente.

étrange n'est ce pas ?

déclaration détaillée de ma macro:




Sub fusion()

'Application.ScreenUpdating = False
Application.DisplayAlerts = False

'--------------------PRECISIONS DES VARIABLES------------------------------------------------------------------------------

Dim monAdress As String, monFichier As String 'déclaration des variables

monAdress = ThisWorkbook.Path 'Variable monAdresse = Adresse du dossier dans lequel il y a mon fichier

monFichier = Dir(monAdress & "\*.xls*") 'Variable monFichier = le premier fichier, qui a comme Adresse l'adresse du dossier de mon fichier + \ , *(kelke soit le nom) . xls

caseLibre = Sheets(Sheets.Count).Range("A65536").End(xlUp).Row + 1 'variable qui selectionne le dernier onglet du dossier est qui cherche la première case libre

Ligne = 1 'variable de ligne pour déterminer la 1ère ligne vide

Nom = ThisWorkbook.Name




'--------------------DECLARATION DE LA MACRO-------------------------------------------------------------------------------

monFichier = Dir(monAdress & "\*.xls*") 'Variable déclarée de nouveau afin de contré le changement déclaration en fin de Macro
Application.DisplayAlerts = False

Do While monFichier <> "" 'boucle jusqu'à ce qu'il n'y ai plus de fichier dispo

If monFichier <> Nom Then

Workbooks.Open monAdress & "\" & monFichier 'je pense ke le probleme vient d'ici !

Workbooks(monFichier).Sheets(1).Range("A1").CurrentRegion.Copy 'copie la totalité des infos présentes dans le fichier temporaire ouvert

Workbooks(Nom).Sheets(Sheets.Count).Activate 'ouvre le dernier onglet du fichier cible
Workbooks(Nom).Sheets(Sheets.Count).Activate '2 fois sinon il ne le lit pas.... pkoi??? je ne sais pas

While (Cells(Ligne, 1)) <> "" 'recherche dans la colone A la ligne libre
Ligne = Ligne + 1
Wend
Cells(Ligne, 1).Select 'selectionne la ligne vide de la colonne A


ActiveSheet.Paste 'colle les données prélevées
Workbooks(monFichier).Close 'ferme le fichier source
End If

monFichier = Dir() 'redefinition de la variable monFichier pour éviter la boucle

Loop 'on recommence la boucle
Range("A1").Select


End Sub

1 réponse

gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 707
21 janv. 2015 à 12:14
Bonjour,

Tu ne précises pas ta version excel.

Si tu fonctionnes avec une version récente, cela peut venir du copy car j'ai découvert des problèmes avec les tableaux.

Copy 'copie la totalité des infos présentes dans le fichier temporaire ouvert
Workbooks(Nom).Sheets(Sheets.Count).Activate 'ouvre le dernier onglet du fichier cible
Workbooks(Nom).Sheets(Sheets.Count).Activate '2 fois sinon il ne le lit pas.... pkoi??? je ne sais pas
While (Cells(Ligne, 1)) <> "" 'recherche dans la colone A la ligne libre
Ligne = Ligne + 1
Wend
Cells(Ligne, 1).Select 'selectionne la ligne vide de la colonne A
ActiveSheet.Paste 'colle les données prélevées

Tu peux remplacer le code ci-dessus par celui-ci
dim tbc()
tbc=Workbooks(monFichier).Sheets(1).Range("A1").CurrentRegion.value
with Workbooks(Nom).Sheets(Sheets.Count)
While .Cells(Ligne, 1) <> "" 'recherche dans la colone A la ligne libre
Ligne = Ligne + 1
Wend
.Cells(Ligne, 1).resize(ubound(tbc),ubound(tbc,2).value=tbc
end with
0