Macro inachevée

ReBonsoir, Personne n'aurait de réponse? Merci!

Merci pour ton intérêt, Mytä.
Voila l'extrait de macro en cause :

"Df = ActiveWorkbook.Sheets.Count

        f = Df

Do

    If Not (Right(Sheets(f).Name, 4) Like An) Then

        SendKeys ("{ENTER}")

        Sheets(f).Delete

    Else

        df0 = Df - 1

    End If

        f = f - 1

Loop While (df0 > 0 Or IsNull(df0) Or IsEmpty(df0)) And f > 0   "

Bonjour,
La procédure complète serait préférable .....ce bout de code me semble boiteux ...!

Salutations.
Le Pingou

Pour résumer: la procédure complète demande de sélectionner une certaine plage sur une feuille du cahier et de la copier sur la 1ère feuille; cela fait elle supprime la feuille d'origine et passe à la suivante. ne fois tout recopier, la macro enregistre le cahier (fichier) qui ne devrait n'avoir qu'une seule feuille, mais dans la pratique les 3 feuilles les plus à droite du cahier ne sont pas supprimées bien que la copie soit faite correctement.
Et encore merci.

"Sub StatAgendaRegrouptCahier()    

    Df = ActiveWorkbook.Sheets.Count

    DM = Worksheets(Df).Name

    Mois = Right(DM, 2)

    An = Left(Right(DM, 7), 4)

    DM = Right(DM, 7)    

    SendKeys ("{LEFT}{ENTER}")

    ActiveWorkbook.SaveAs Filename:= _

        "D:\D-Mes documents\Cs4_GENERALES\Docts" & An & "\StatsCs\RecapStatCs" & An & "-" & Mois & ".xls" _

        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False    

    f = 1   ' f = Index feuille courante

    NoP1 = 0    ' NoP1 = Index feuille recapitulative

Do

        Worksheets(f).Activate

        NF = Worksheets(f).Name     '   NF = Nom feuille courante, Index (f)        

If Left(NF, 3) = Mid(Cells(2, 2), 8, 3) And Not (IsNull(NFN) Or IsEmpty(NFN)) Then

'     si 3_1er caractères du nom de la feuille courante = n°UH de cellule UH

        Cells(2, 1).Select

    If IsEmpty(Cells(3, 1)) Then

        Range(Cells(2, 1), Cells(2, 9)).Select  'Selectionne la ligne entière

    Else

        SelectPave   'Selectionne une plage entière

    End If    

        Selection.Copy

        Sheets(NFN).Select

        Cells(l + 1, 1).Select

        ActiveSheet.Paste

        l = Cells(1, 1).End(xlDown).Row

Else

        NFN = Left(Cells(2, 2), 4) & "#" & Mid(Cells(2, 2), 8, 3) & "#" & Mid(Cells(2, 2), 14, 25) & "#" & An

        NFN = IIf(Len(NFN) < 32, NFN, Left(NFN, 26) & Right(NFN, 5))

        Sheets(NoP1 + 1).Select

        Sheets.Add

        ActiveSheet.Name = NFN

        f = f + 1

        NoP1 = Worksheets(NFN).Index

        Sheets(f).Select

        Cells(1, 1).Select

        SelectPave

        Selection.Copy

        Sheets(NoP1).Select

        ActiveSheet.Paste

        l = Cells(1, 1).End(xlDown).Row

        Df = Df + 1

End If

        f = f + 1

Loop While f < Df + 1



        Df = ActiveWorkbook.Sheets.Count

        f = Df

Do

    If Not (Right(Sheets(f).Name, 4) Like An) Then

        SendKeys ("{ENTER}")

        Sheets(f).Delete

    Else

        df0 = Df - 1

    End If

        f = f - 1

Loop While (df0 > 0 Or IsNull(df0) Or IsEmpty(df0)) And f > 0

    Columns("E:H").HorizontalAlignment = xlCenter    

Worksheets(1).Name = "ImportActiviteMedecins"

Cells(1, 1).Activate

ActiveWorkbook.Save

'    Enregistrement après regroupement des pages sur une seule sous le nom "ImportActiviteMedecins"

End Sub"  

Bonjour,
Merci, il se fait tard, réponse demain dans la journée.

Merci à tous!
Pour compléter ma question, je me souviens avoir lu qq part une instruction qui permettait d'attendre que la boucle soit complètement exécutée avant de passer à l'instruction suivante. Mais je ne sais plus si c'était dans VBA Access, et alors je suppose qu'il existe la même avec Excel, et de toutes façons je ne l'avais pas comprise.

Bonjour,
J'ai créé un fichier selon les informations que j'ai trouvé et votre procédure ne fait pas ce que vous avez décrit (la procédure complète demande de sélectionner une certaine plage sur une feuille du cahier et de la copier sur la 1ère feuille; cela fait elle supprime la feuille d'origine et passe à la suivante. ne fois tout recopier, la macro enregistre le cahier (fichier) qui ne devrait n'avoir qu'une seule feuille, mais dans la pratique les 3 feuilles les plus à droite du cahier ne sont pas supprimées bien que la copie soit faite correctement).
Résultat : le nouveau classeur avec une seule feuille [ImportActiviteMedecins] c'est en ordre mais la valeur qui avait été compilées sont supprimées.... !
Dans votre procédure pourquoi la ligne de code :

SendKeys ("{LEFT}{ENTER}")   

?
Et celle-ci :

SelectPave

est-ce l'appel d'une autre procédure .... ?

Bonjour,
Sans réponse de votre part il est impossible d'en faire plus....!

Salutations.
Le Pingou

Bonjour, Le Pingou,
Je n'avais pas du tout oublié ma question ni bien sûr ta proposition de réponse; seulement je ne suis pas encore en retraite (qq mois !!!) et je suis rentré assez tard, juste un peu plus d'une heure. Et je viens juste d'ouvrir ma machine.

Cela dit, effectivement "SelectPave" est une autre macro qui sélectionne une plage "compacte" càd sans ligne ni colonne vides, elle définit elle-même ses dimensions selon la colonne la plus à gauche et la ligne supérieure.
Son expression est très simple:

Sub SelectPave()
    l1 = ActiveCell.Row
    C1 = ActiveCell.Column  
    Cells(l1, C1).End(xlToRight).Select
    c2 = ActiveCell.Column
    Cells(l1, C1).End(xlDown).Select
    l2 = ActiveCell.Row    
    Range(Cells(l1, C1), Cells(l2, c2)).Select
End Sub

Quant à l'expression : "SendKeys()" , elle est là pour passer outre à la boite de dialogue avertissant que la page supprimée contient des données qui vont être perdues.
Pour répondre à vos questions!
..... Je regarde plus attentivement le reste de vos remarques.
Bien à vous

Bonjour,
Merci pour l'information.
C'est en ordre pour la procédure [SelectPave]. Par contre le code [SendKeys ("{LEFT}{ENTER}")] et [SendKeys ("{ENTER}")] ne fait qu'insérer des lignes vides dans la procédure et n'a aucun effet sur le message d'avertissement... !
J'ai découvert un autre problème car dans la première boucle vous ajouter la copie d'une feuille existante (qui peut se répéter plusieurs fois selon votre code...).
Le gros problème est que je ne peux pas (sur la base du fichier que j'ai tenté de créer)déterminer ou intervenir car votre code ne fait pas ce que vous avez décrit.

Est-il possible d'avoir une copie du fichier.... ?

Question, vous réalisez cette compilation chaque jour, semaine, mois .... ?

Salutations.
Le Pingou

Bonjour, et merci pour la réponse;
Je vous envoie tout ça demain soir, car j'ai cela au travail mais pas à domicile.
En fait, ça marche bien, mais j'ai pu trouver le temps en fin d'AM pour faire un pas à pas. En réalité, ce n'est pas la fin de boucle qui foire mais le début, les 3*1ères qui ne suppriment pas la feuille voulue, ce qui fait qu'au lieu d'avoir un fichier (cahier) avec une seule feuille comme souhaité, j'en ai 4 dont les 3 dont je parle. D'autre part, et j'avais oublié, la macro est "régressive", j'entends qu'elle ne commence pas par la 1ère mais par la dernière et remonte vers la 1ère (c'est comme celui qui supprimerait le dernier wagon d'un train, il supprimerait toujours le dernier wagon, jusqu'à ce qu'il n'en reste qu'un seul); mais je pense que surtout cette macro vient en fin d'une série de macros imbriquées les unes dans les autres où celle-là est la dernière. Pour finir mon explication je dirai que je pars de plusieurs feuilles PDF recopiées dans Excel et que je suis obligé de "casser" pour les transférer dans une Table Access.
Pour ce qui est de la périodicité de l'exercice, il est mensuel.
Bien à vous.

Bonjour,
Merci, alors j'attends la suite.
Pour votre information j'ai préparé une procédure en gardant les parties utiles (à mes yeux) :

Sub StatAgendaRegrouptCahier_vjpp()
Df = ActiveWorkbook.Sheets.Count
DM = Worksheets(Df).Name ' Nom de la dernière feuille ..!!!!! mafeuilee201311
Mois = Right(DM, 2)
An = Left(Right(DM, 7), 4)
DM = Right(DM, 7)
delireca = 2
' *** sur mon poste
' *** ActiveWorkbook.SaveAs Filename:="C:\Users\PJP\Desktop\RecapStatCs" & An & "-" & Mois & ".xls", FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
ActiveWorkbook.SaveAs Filename:= _
"D:\D-Mes documents\Cs4_GENERALES\Docts" & An & "\StatsCs\RecapStatCs" & An & "-" & Mois & ".xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
' Insérer feuille récapitulative
Sheets.Add before:=Sheets(1)
ActiveSheet.Name = "ImportActiviteMedecins"
Set shrecap = ActiveSheet
shrecap.Range("A1:I1") = Array("titre 1", "titre 2", "titre 3", "titre 4", "titre 5", "titre 6", "titre 7", "titre 8", "titre 9")
' boucle réspérer données des feuilles
For Each sh In Worksheets
    If sh.Name <> "ImportActiviteMedecins" Then
       sh.Activate
        'Do
        'Worksheets(f).Activate
    '    NF = Worksheets(f).Name ' NF = Nom feuille courante, Index (f)
        NF = sh.Name
        If Left(NF, 3) = Mid(Cells(2, 2), 8, 3) And Not (IsNull(NFN) Or IsEmpty(NFN)) Then
            ' si 3_1er caractères du nom de la feuille courante = n°UH de cellule UH
            'sh.Cells(2, 1).Select
            If IsEmpty(Cells(3, 1)) Then
                Range(Cells(2, 1), Cells(2, 9)).Copy Destination:=shrecap.Cells(delireca, 1)
            Else
                l2 = Cells(Rows.Count, 1).End(xlUp).Row
                c2 = Cells(2, Columns.Count).End(xlToLeft).Column
                Range(Cells(2, 1), Cells(l2, c2)).Copy Destination:=shrecap.Cells(delireca, 1)
            End If
        Else
            NFN = Left(Cells(2, 2), 4) & "#" & Mid(Cells(2, 2), 8, 3) & "#" & Mid(Cells(2, 2), 14, 25) & "#" & An
            NFN = IIf(Len(NFN) < 32, NFN, Left(NFN, 26) & Right(NFN, 5))
            l2 = sh.Cells(Rows.Count, 1).End(xlUp).Row
            c2 = sh.Cells(2, Columns.Count).End(xlToLeft).Column
            Range(Cells(2, 1), Cells(l2, c2)).Copy Destination:=shrecap.Cells(delireca, 1)
         End If
         delireca = shrecap.Cells(Rows.Count, 1).End(xlUp).Row + 1
    End If
Next sh

For Each sh In Worksheets
    Application.DisplayAlerts = False
    If sh.Name <> "ImportActiviteMedecins" Then
        sh.Delete
    End If
Next sh
Application.DisplayAlerts = True
Columns("E:H").HorizontalAlignment = xlCenter
ActiveWorkbook.Save
' Enregistrement après regroupement des pages sur une seule sous le nom "ImportActiviteMedecins"
End Sub

Vue que vous faite l'opération tous les mois, ne serait-il pas mieux de créer un classeur de récapitulation avec une feuille par mois et on copie directement les données des classeurs de détail.... ? En plus la procédure reste dans ce classeur.

Bonsoir,
Passé plus de 3 heures à préparer une version propre à vous être envoyée (élagage des approximations + anonymation du fichier) , enfin qqch de présentable.

http://cjoint.com/?3KvcMke3RX0

Pour faire tourner la bête, vous devez sélectionner la macro "StatAgendaRegrouptCahier"

Vous constaterez que la dernière feuille n'est pas supprimée comme cela devrait, et plus gênant encore, au travail ce sont les 4 dernières qui ne sont pas supprimées. Je me demande donc si le problème ne vient pas de la rapidité de la machine ????

Avec tous ces soucis de mise au point, je n'ai malheureusement pas eu le temps de regarder votre envoi, et il est très tard!!!

Avec tous mes remerciements!

Bonjour,
Merci pour le fichier, je constate que c'est une version 97-2003 (xls), qu'elle est la version exacte de votre MS Office... ? .
Que pensez-vous de ma proposition en fin du message précédent.... ?

Bonjour,
Je complète rapidement ma réponse de cette nuit,(avant de partir).
Je suis sur Excel2003 simplement parce que c'est l'outil qu'on veut bien me donner (au travail), à domicile j'ai E2010. Il est question qu' "on" me donne une nouvelle machine mais j'attends.
La réalité est que toutes mes procédures sont sur un fichier particulier, vide de toutes données, et j'y ai accès par des barres d'outils et une série de boutons personnalisés. Bien évidemment, tout ça de ma propre fabrication.
J'ai 36 noms (peut être trop) de fichiers intermédiaires selon l'avancée de la procédure, ne serait ce que pour sauvegarder les différentes étapes. A l'arrivée, j'ai une table annuelle qui est complétée chaque mois par cette même procédure, et en plus, comme je vous disait, tout est importer dans une table Access, avec laquelle je suis bien plus à l'aise et que je trouve beaucoup plus souple quant aux sélections. Ainsi, j'ai les données pour les 4 dernières années, date à la quelle je suis arrivé. Cela étant dit, il faut se rendre à l'évidence que certaines tâches sont plus aisées avec Excel, mais les capacités de la suite Office permettent le passage de l'un à l'autre passablement confortable.

j'ai transféré votre proposition sur un module idoine, je l'emporte pour la regarder à fond.
Je vous souhaite une bonne journée.
A ce soir. Et encore merci.

Bonsoir LePingou!
J'ai pu tester votre macro sur la même maquette anonymisée que celle que j'ai postée. Le résultat est des plus probants. J'ai fait un pas à pas, ainsi qu'un passage sans arrêt. Tout passe parfaitement. Aussi je vous adresse un grand merci!
Maintenant, il me reste à comprendre les outils utilisés; ça risque d'être plus corsé, d'autant que je ne suis vraiment pas un spécialiste. Aussi j'aurai sans aucun doute pas mal de questions supplémentaires à ce sujet. C'est pourquoi je ne mets pas la question comme étant résolue.
A bientôt!

Bonjour,
Merci, pour ma procédure c'est un coup de chance car j'ai reconstruit un fichier selon votre procédure ce qui n'était pas évident... !
Superbe découverte pour moi, j'ai fait un pas à pas sur l'ensemble, c'est parfait. Le résultat final est conforme sans avoirs le problème de feuille en plus comme cela se produit chez vous.
Je vous suggère toutefois de supprimer l'instruction [SendKeys ("{LEFT}{ENTER}") ] et [SendKeys ("{ENTER}")] dans la procédure [StatAgendaRegrouptCahier3()] et de mettre à la place [Application.DisplayAlerts = False] juste après l'instruction [Do] (boucle...Sheets(f).Delete) et [Application.DisplayAlerts = True] après l'instruction [Loop While (df0.....].
C'est possible d'améliorer les procédures mais cela impose de tout reprendre, je pense que ce n'est pas peine de changer pour changer.... !

Bonsoir,
Je suis en train de lire attentivement le détail de votre procédure. Effectivement je découvre également pas mal de choses et en particulier des outils beaucoup plus légers que ceux que j'avais mis, que ce soit range().copy destination:= NomFeuille() ou bien le ARRAY() que je n'ai jamais pu appréhender, ou encore la possibilité d'indiquer les bornes droite et basse d'une plage (pavé) sans passer par le décompte. Autant de choses dont je vous remercie.
Cela dit, vous aurez pu constater (si tant est que vous ne le sachiez déjà) que les pauvres autodidactes que nous sommes, à défaut de maitrise et de connaissance techniques approfondies il faut procéder avec astuces pour contourner les obstacles.
Bien à vous.

Bonjour,
Merci, je suis content pour vous. J'en suis un aussi.......pauvre non .... mais....!
Au plaisir de vous retrouver sur le forum.