BDD (170entrées) à exporter vers fichier excel "modèle (soit autant de fichiers créés que de lignes)

[invite05a67b21]

Bonjour,

J’ai besoin que vous éclairiez mes lanternes et de votre aide

Voilà le contexte, j'ai un fichier Excel qu'on appellera "A" de 1700 lignes sur 10 colonnes (Date, prix, nom, adresse, description...etc.).

J'ai un deuxième fichier Excel "B", le modèle dans lequel je dois (actuellement) copier-coller les informations une à une du fichier "A".

Au final je me retrouve avec 1700 fichiers identiques en tout point, avec en plus les infos que j'ai importé de "A".

L'idée étant de savoir s'il est possible d'automatiser cette tache ? Une méthode permettant de copier toujours aux mêmes endroits les infos.
En pensant à incrémenter de 1 les lignes ==> à chaque incrément, un nouveau fichier "B" est créé avec les infos de "A".

Je ne sais pas si c'est assez clair, mais n'hésitez pas à me poser des questions.

Merci beaucoup,

Silentman

[invite60415e49]

Bonjour
Voici une macro qui essaye de faire tant bien que mal tes manipulations
Tu créer un nouveau module dans visualbasique, ou tu colle le code
Tu modifie la valeur de nomA par le nom de ton fichier a éclater
Tu modifie le préfixe de nomB par ce que tu veux (ici fichier_)
Tu lance la macro ‘split ‘
Cela te créer autant de fichiers que tu as de lignes, dans le même répertoire que ton fichier courant

Sub split()
Dim nomB As String
Dim nomA As String 'le nom de ton fichier A
nomA = "A" 'le nom de ton fichier A est A.xls (les données sont dans la feuille "Feuil1")
' le nom de ton fichier b commencera par "fichier_" incrementé du numéro de la ligne a toi de le changer
nomB = "fichier_"

a = 1
chemin = ActiveWorkbook.Path
Application.ScreenUpdating = False 'pour eviter de perdre 3 dixieme a chaque boucle


'on boucle tant que la cellule courante n'est pas vide
While Workbooks(nomA & ".xls").Worksheets("feuil1").C ells(a, 1) <> ""
'creation du fichier B pour la ligne a
Set NewBook = Workbooks.Add
With NewBook
.SaveAs Filename:=chemin & "\" & nomB & a & ".xls"
End With

b = 1
While b < 10

'copy de la ligne a du fichier A
Workbooks(nomA & ".xls").Worksheets("Feuil1").C ells(a, b).Copy

'colle la ligne dans le fichier NomB a la ligne 1 de la feuille "feuil1"
Workbooks(nomB & a & ".xls").Activate
Cells(1, b).PasteSpecial (xlPasteAll)
b = b + 1
Wend
'on ferme le fichier B
Workbooks(nomB & a & ".xls").Close SaveChanges:=True

'on continu pour la ligne suivante
a = a + 1
Wend

Application.ScreenUpdating = True

End Sub

Je sais les 2 boucles sont super moches, mais je n’ai pas réussi a faire une copie de range(cells(a,1),cells(a,10))

Bon courage

[invite05a67b21]

Bonjour
Voici une macro qui essaye de faire tant bien que mal tes manipulations
Tu créer un nouveau module dans visualbasique, ou tu colle le code
Tu modifie la valeur de nomA par le nom de ton fichier a éclater
Tu modifie le préfixe de nomB par ce que tu veux (ici fichier_)
Tu lance la macro ‘split ‘
Cela te créer autant de fichiers que tu as de lignes, dans le même répertoire que ton fichier courant



Je sais les 2 boucles sont super moches, mais je n’ai pas réussi a faire une copie de range(cells(a,1),cells(a,10))

Bon courage

Merci pour ta réponse rapide !!!
Je voulais savoir comment appeler un fichier dans un dossier bien spécifique.

Exemple : Set nomA = Workbooks.Open(FileName:="C:\D ocuments and Settings\ba\Bureau\laboratoire excel\Base.xls") j'ai des erreurs 1004 tout le temps...

Le fichier destination nomB, ne doit pas être crée. En fait c'est un modèle dans lequel je dois copier/coller des infos de nomA.

L'idéal serait de pouvoir ouvrir nomB, de copier les données venant de A qui m'interesse et ensuite de l'enregistrer sous un nom issue d'une des cellule de A toujours.

Exemple : Fichier nomA = Base.xls
A B C D E
1 P0123ABC 12 Pile 122 OK
2 X0123ABC 15 Boite 25 OK
3
...

Il faut que le fichier B s'appelle : P0123ABC.xls avec les données de A comme je veux.

C'est assez tarabiscoté, mais je pense qu'il doit y avoir moyen de le faire. Malheureusement j'ai codé en VBA il y a longtemps mais j'ai tout perdu...

Merci,

silentman

[invite60415e49]

bon .. en générale je prend 160€/de l'heure (je plaisante)

créer un fichier modele.xls
et renomme ton fichier de données brute en Données.xls (ou change les nom dans la macro)

Sub répartition()

'bon pasque je suis gentil
'un fichier nomA qui contient toute tes données
'un fichier nomM qui contient le modele , present dans le meme répertoire que nomA et qui a un module contenant cette macro
' pour chaque ligne de A , on fait une copie de NomM on la renomme NomB , on lui colle les cellules ou il faut (ici a partir de la ligne 2-je suppose que la ligne 1 contient des entête de colonne)
'et on enregistre le nomB modifié

Dim nomB As String
Dim nomA As String 'le nom de ton fichier A
Dim NomM As String
nomA = "Données.xls"
NomM = "Modele.xls"
chemin = ActiveWorkbook.Path

Application.ScreenUpdating = False 'pour éviter de perdre 3 dioptries a chaque boucle

Workbooks.Open (nomA)
a = 1
'on boucle tant que la cellule courante n'est pas vide
While Workbooks(nomA).Worksheets("fe uil1").Cells(a, 1) <> ""
'creation du fichier B pour la ligne a
nomB = Workbooks(nomA).Worksheets("fe uil1").Cells(a, 2).Value & ".xls"

ActiveWorkbook.SaveCopyAs (chemin & "\" & nomB)
'le fichier est creer mais pas ouvert pour lui copier des lignes
Workbooks.Open (nomB)
b = 1
While b < 10

'copy de la ligne a du fichier A
Workbooks(nomA).Worksheets("Fe uil1").Cells(a, b).Copy

'colle la ligne dans le fichier NomB a la ligne 1 de la feuille "feuil1"

Workbooks(nomB).Activate
Range(Cells(2, b), Cells(2, b)).PasteSpecial (xlPasteAll)
b = b + 1
Wend
'on ferme le fichier B
Workbooks(nomB).Close Savechanges:=True

'on continu pour la ligne suivante
a = a + 1
Wend
Workbooks(nomA).Close Savechanges:=True
Application.ScreenUpdating = True
'ouverture du répertoire contenant les fichiers
Shell "C:\WINDOWS\EXPLORER.EXE /n,/e," & chemin & "\", vbNormalFocus
'fermeture du modele.xls
ActiveWorkbook.Close Savechanges:=True
End Sub

j'espère que cela te conviendra tu peut modifier facilement l'endroit de collage
bon courage

[A voir en vidéo sur Futura]

[invite05a67b21]

Bonjour,

j'ai finalement réussi a mettre en place plus ou moins mon schmilblick !!
Merci pour l'aide précieuse sinon j'aurais surment et après ...

@++

silentman