Dupliquer lignes et concerser le format TEXTE colonne B et H

Fermé
GuipLyon Messages postés 4 Date d'inscription samedi 2 août 2014 Statut Membre Dernière intervention 19 février 2015 - 19 févr. 2015 à 14:37
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 - 19 févr. 2015 à 15:56
Bonjour,


J'utilise une macro pour dupliquer extrêmement rapidement des lignes : voir code ci-dessous). Ce code m'a été donné l'année dernière et il marche à merveille.
https://www.cjoint.com/?0BtoNJ6l6Ti
J'ai mis le fichier que j'utilise ci-dessus.
Mes colonnes B et H sont au format "Texte".

Lorsque j'applique la macro, le format "Texte" disparaît.
Je perds alors tous les zero devant le 1. (double cliquer sur une cellule pour vérifier)

Je dois impérativement conserver le format "texte" pour pouvoir importer ces données en comptabilité.
Avec la macro actuelle, mes données sont enregistrées en classe 1 ce qui est faux.
Mes données doivent être enregistrées en 01 et non en 1..... ce ne sont pas du tout les mêmes codes comptables.

Si vous avez une solution à me proposer, tout en conversant cette macro (elle est extrêmement rapide), je suis preneur.

Merci à vous par avance.



Sub milliers_de_lignes()
Dim Derlig As Long, T_caisse, T_logiciel
Dim Idx As Long, Col_l As Byte, Col_c As Byte
Dim Start As Single 'pour essai

'initialisation
Start = Timer
Application.ScreenUpdating = False
Derlig = Range("A" & Rows.Count).End(xlUp).Row
T_caisse = Range("A2:G" & Derlig)
ReDim T_logiciel(1 To UBound(T_caisse) * 2, 1 To 7)

'creation lignes "2" pour conformité logiciel
For Idx = 1 To UBound(T_caisse)
Col_c = 1
For Col_l = 1 To 7
T_logiciel((Idx * 2) - 1, Col_l) = T_caisse(Idx, Col_l)
Col_c = Choose(Col_l, 6, 2, 4, 3, 5, 1, 7)
T_logiciel(Idx * 2, Col_l) = T_caisse(Idx, Col_c)
Next Col_l
Next Idx
' restitution tableau conforme
Range("A2").Resize(UBound(T_logiciel), 7) = T_logiciel
'pour essai
Application.ScreenUpdating = True
MsgBox "durée pour 4400 lignes: " & Timer - Start & " sec."
End Sub
A voir également:

1 réponse

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
19 févr. 2015 à 15:56
Bonjour,

fichier modifie: https://www.cjoint.com/c/EBtqgRzeZgf
0