Code à modifier
Résolu
nico2
-
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
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
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/ -
-
Bonjour
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
-
