Probleme pour extraire des données lors de rupture de champs Fermé

Question

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 : [/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 est" + Range("A" & 1) Windows(nom).Activate Sheets("Feuil1").Select J = i + 1 End If i = i + 1 Wend End Sub Merci infiniment par avance. Configuration: Windows 7 / Mozilla 11.0

f894009 · Answer

Bonjour,
ma maccro fait le boulot mais uniquement sur le premier champ
Le premier champ c'est quoi, une colonne ou ...???

Bajam · Answer

Oui c'est une colonne c'est bien ca

yg_be · Answer

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 ligne If 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 · Answer

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 emp" + CStr(Range("A" & 2)) Windows(nom).Activate Sheets(1).Select J = i + 1 End If i = i + 1 Wend End Sub bon boulot!

Probleme pour extraire des données lors de rupture de champs

4 réponses

Discussions similaires