Code à modifier
Résolu
nico2
-
yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention -
yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour
J'ai ce code qui fonctionne bien pour mon fichier dont la source
débute en ligne 2 la ligne 1 étant les entêtes .
Je n'arrive pas à modifier ce code pour un autre fichier .
La ligne 3 étant les entêtes le début les infos a transférer commencent en ligne 408.
Pouvez vous svp me dire ce que je dois modifier pour réussir à faire fonctionner ce code dans mon autre fichier
Je vous remercie
Sub Extrait()
Set f = Sheets("BD")
'--- Liste des élèves
f.[A1:D10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=f.[K1], Unique:=True
For Each c In f.Range("K2:K" & f.[K65000].End(xlUp).Row) ' pour chaque élève
f.[K2] = c.Value
On Error Resume Next
temp = CStr(c.Value)
Sheets(temp).Select ' la feuille existe t-elle?
If Err <> 0 Then
Sheets("Modèle").Copy After:=Sheets(Sheets.Count) ' création
ActiveSheet.Name = temp
End If
'-- extraction
f.[A1:D10000].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=f.[K1:K2], CopyToRange:=[A1:D1]
Next c
End Sub
J'ai ce code qui fonctionne bien pour mon fichier dont la source
débute en ligne 2 la ligne 1 étant les entêtes .
Je n'arrive pas à modifier ce code pour un autre fichier .
La ligne 3 étant les entêtes le début les infos a transférer commencent en ligne 408.
Pouvez vous svp me dire ce que je dois modifier pour réussir à faire fonctionner ce code dans mon autre fichier
Je vous remercie
Sub Extrait()
Set f = Sheets("BD")
'--- Liste des élèves
f.[A1:D10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=f.[K1], Unique:=True
For Each c In f.Range("K2:K" & f.[K65000].End(xlUp).Row) ' pour chaque élève
f.[K2] = c.Value
On Error Resume Next
temp = CStr(c.Value)
Sheets(temp).Select ' la feuille existe t-elle?
If Err <> 0 Then
Sheets("Modèle").Copy After:=Sheets(Sheets.Count) ' création
ActiveSheet.Name = temp
End If
'-- extraction
f.[A1:D10000].AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=f.[K1:K2], CopyToRange:=[A1:D1]
Next c
End Sub
A voir également:
- Modifier logement universitaire sims 4
- Modifier dns - Guide
- Modifier liste déroulante excel - Guide
- Modifier story facebook - Guide
- Code gta 4 ps4 - Guide
- Modifier extension fichier - Guide
3 réponses
Bonjour,
Pouvez mettre un fichier exemple avec une feuille qui "marche" avec votre code et une feuille pour modif du code.
Le nouveau fichier doit avoir la meme mise en page pour la creation de feuille?
Pour transmettre un fichier,
Veillez a ce qu'il n'y ait PAS DE DONNEES CONFIDENTIELLES
il faut passer par un site de pièce jointe tel que cjoint.com
Allez sur ce site : https://www.cjoint.com/
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse...
ou
'mon partage
https://mon-partage.fr/
Pouvez mettre un fichier exemple avec une feuille qui "marche" avec votre code et une feuille pour modif du code.
Le nouveau fichier doit avoir la meme mise en page pour la creation de feuille?
Pour transmettre un fichier,
Veillez a ce qu'il n'y ait PAS DE DONNEES CONFIDENTIELLES
il faut passer par un site de pièce jointe tel que cjoint.com
Allez sur ce site : https://www.cjoint.com/
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse...
ou
'mon partage
https://mon-partage.fr/
Bonjour
Merci pour votre aide ci-dessous le fichier avec les explications
https://www.cjoint.com/c/KBrqJuMlr4G
Cordialement
Merci pour votre aide ci-dessous le fichier avec les explications
https://www.cjoint.com/c/KBrqJuMlr4G
Cordialement
Re,
code modifie: https://mon-partage.fr/f/48Dm5u1u/
A tester avec plus de donnees pour confirmation
code modifie: https://mon-partage.fr/f/48Dm5u1u/
A tester avec plus de donnees pour confirmation
