Probleme pour extraire des données lors de rupture de champs
bajam454
Messages postés
1
Statut
Membre
-
yg_be Messages postés 23437 Date d'inscription Statut Contributeur Dernière intervention -
yg_be Messages postés 23437 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour à tous,
Je vous explique ce que j'aimerais faire, alors j'ai des fichiers .xls et ce que j'aimerais faire c'est qu'il soit possible a chaque rupture de champs de générer un nouveau fichier xls et de séparer les donnes afin de bien ventiler.
Problèmes :
- Comment faire pour agir sur un autre champs que le premier ? ma maccro fait le boulot mais uniquement sur le premier champ, hélas j'ai besoin de pouvoir l'utiliser sur d'autres champs, que faire ?
- Comment faire en sorte de toujours garder et copier la première ligne dans chaque nouveau fichier qui elle contient les entêtes de champs ?
Le code :
Merci infiniment par avance.
Je vous explique ce que j'aimerais faire, alors j'ai des fichiers .xls et ce que j'aimerais faire c'est qu'il soit possible a chaque rupture de champs de générer un nouveau fichier xls et de séparer les donnes afin de bien ventiler.
Problèmes :
- Comment faire pour agir sur un autre champs que le premier ? ma maccro fait le boulot mais uniquement sur le premier champ, hélas j'ai besoin de pouvoir l'utiliser sur d'autres champs, que faire ?
- Comment faire en sorte de toujours garder et copier la première ligne dans chaque nouveau fichier qui elle contient les entêtes de champs ?
Le code :
[/contents/446-fichier-sub Sub] Ruptures()
Dim i, J
Dim nom
nom = (ThisWorkbook.Name)
i = 1
J = 1
While Range("A" & i) <> ""
If Range("A" & i) <> Range("A" & i + 1) Then
Rows(J & ":" & i).Select
Selection.Copy
Workbooks.Add
Rows(1 & ":" & 1).Select
ActiveSheet.Paste
' C'est ici qu'il faut modifier le repertoire d'enregistrement souhaité
ActiveWorkbook.SaveAs Filename:="C:\Users\xp\Desktop\Travaux\MacroVBA\test\" + Range("A" & 1)
Windows(nom).Activate
Sheets("Feuil1").Select
J = i + 1
End If
i = i + 1
Wend
End Sub
Merci infiniment par avance.
4 réponses
-
Bonjour,
ma maccro fait le boulot mais uniquement sur le premier champ
Le premier champ c'est quoi, une colonne ou ...??? -
-
yg_be Messages postés 23437 Date d'inscription Statut Contributeur Dernière intervention Ambassadeur 1 588
Comme ta macro copie des lignes complètes, je suppose que c'est la détection de rupture que tu veux changer en tenant compte de plusieurs colonnes.
Si c'est bien cela, tu pourrais modifier la ligneIf Range("A" & i) <> Range("A" & i + 1) Then
en, par exemple :If (Range("A" & i) <> Range("A" & i + 1)) or (Range("B" & i) <> Range("B" & i + 1)) Then
Cela va détecter une rupture si il y a un changement dans la colonne A OU la colonne B. -
yg_be Messages postés 23437 Date d'inscription Statut Contributeur Dernière intervention Ambassadeur 1 588
Je propose ceci pour toujours garder et copier la première ligne dans chaque nouveau fichier. A toi de l'adapter à ton exemple.Option Explicit Sub Ruptures() Dim i, J Dim nom Dim original As Workbook, nouveau As Workbook Set original = ThisWorkbook nom = (ThisWorkbook.Name) i = 2 J = 2 While original.Sheets(1).Range("A" & i) <> "" If Range("A" & i) <> Range("A" & i + 1) Then Rows(J & ":" & i).Select Selection.Copy Set nouveau = Workbooks.Add Rows(2 & ":" & 2).Select ActiveSheet.Paste original.Sheets(1).Rows(1).Copy nouveau.ActiveSheet.Rows(1) ' C'est ici qu'il faut modifier le repertoire d'enregistrement souhaité ActiveWorkbook.SaveAs Filename:="C:\data\temp\" + CStr(Range("A" & 2)) Windows(nom).Activate Sheets(1).Select J = i + 1 End If i = i + 1 Wend End Sub
bon boulot!
