Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel decouper un fichier excel

decouper un fichier excel

2 réponses
Avatar
Lalouve
Bonjour à tous !
Voilà mon problème :
j'ai un fichier Excel se présentant de la façon suivante :

SOCIETE CLIENT DATE ....... ETC
A04 AAA 01/01/2006
A04 BBB 01/01/2006
C85 AAB 01/02/2006
C85 AAC 01/12/2005

le tout sur 4000 lignes et une 20taine de colonne comprenant environ 200
sociétés

Le but du jeu est de créer un classeur par sociétés reprenant les entêtes,
les lignes correspondantes à chaque société et d'enregistrer le nouveau
classeur sous les références des sociétés. Evidemment il est possible de les
créer un par un mais c'est long et fastidieux et j'aimerais une procédure
qui puisse me faire gagner du temps
car après il me faut joindre les fichiers ainsi créés à un mail, évidemment
un mail par sociétés ....
Y'a du boulot ...... c'est pour cela je fais appel au petit génies d'Excel
merci à tous
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
JB
Bonjour,

http://cjoint.com/?cwr2phXyru

Sub CreeClasseurs()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ExtraitService
For Each c In Range("I2", Range("I2").End(xlDown))
Range("G3") = c
Sheets("Modèle").Select
Sheets("BD2").Range("A1:D10000").AdvancedFilter
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("BD2").Range("G2:G3"),
CopyToRange:=Sheets("Modèle").Range("A1:D1"), Unique:úlse
ActiveSheet.Copy
ActiveSheet.Name = c
ActiveWorkbook.SaveAs Filename:=c
ActiveWorkbook.Close
Sheets("BD2").Select
Next c
End Sub

Nom Service Salaire Qualif
Cowan Compta 3 000,00 € Q2
Dang Compta 3 000,00 € Q1
Dupont Compta 3 000,00 € Q1
Martin Compta 3 011,00 € Q8
Ceuzin Etudes 3 000,00 € Q2
Dupond Etudes 3 000,00 € Q2
Durand Etudes 3 000,00 € Q2
Dykiel Etudes 3 000,00 € Q1

G H I
1 Critère Service
2 Service Compta
3 Pers Etudes
Fabric


Cordialement JB
Avatar
Lalouve
merci milles fois c'est tout à fait ce que je désire



"JB" a écrit dans le message de
news:
Bonjour,

http://cjoint.com/?cwr2phXyru

Sub CreeClasseurs()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ExtraitService
For Each c In Range("I2", Range("I2").End(xlDown))
Range("G3") = c
Sheets("Modèle").Select
Sheets("BD2").Range("A1:D10000").AdvancedFilter
Action:=xlFilterCopy, _
CriteriaRange:=Sheets("BD2").Range("G2:G3"),
CopyToRange:=Sheets("Modèle").Range("A1:D1"), Unique:úlse
ActiveSheet.Copy
ActiveSheet.Name = c
ActiveWorkbook.SaveAs Filename:=c
ActiveWorkbook.Close
Sheets("BD2").Select
Next c
End Sub

Nom Service Salaire Qualif
Cowan Compta 3 000,00 ? Q2
Dang Compta 3 000,00 ? Q1
Dupont Compta 3 000,00 ? Q1
Martin Compta 3 011,00 ? Q8
Ceuzin Etudes 3 000,00 ? Q2
Dupond Etudes 3 000,00 ? Q2
Durand Etudes 3 000,00 ? Q2
Dykiel Etudes 3 000,00 ? Q1

G H I
1 Critère Service
2 Service Compta
3 Pers Etudes
Fabric


Cordialement JB