Itération de macros Excel

Bonjour,

J'ai un petit soucis sur excel.
Je souhaite reprendre les informations de certains documents Excel qui ont toujours la même forme dans un tableau récapitulatif qui n'est pas dans le même classeur.
Je suis parvenu à le faire pour l'un des documents de mon dossier mais je n'arrive vraiment pas à appliquer la macro à tous les fichiers de mon dossiers?
Auriez vous des pistes sur la démarche à suivre?

Ci dessous la macro pour un document que j'aimerais reproduire sur tous ceux du dossier
"ficheappel".

Merci d'avance !

Sub import()

Dim classeurSource As Workbook, classeurDestination As Workbook
'ouvrir le classeur source (en lecture seule)

Set classeurSource = Application.Workbooks.Open("C:\ficheappel\ficheappel(1).xlsm", , True)
'définir le classeur destination
Set classeurDestination = ThisWorkbook

'copier les données de la "Feuil1" du classeur source vers la "Feuil1" du classeur destination
classeurSource.Sheets("Feuil1").Range("C6").Copy classeurDestination.Sheets("Feuil1").Range("A2")
classeurSource.Sheets("Feuil1").Range("C8").Copy classeurDestination.Sheets("Feuil1").Range("B2")
classeurSource.Sheets("Feuil1").Range("C10").Copy classeurDestination.Sheets("Feuil1").Range("C2")
classeurSource.Sheets("Feuil1").Range("C12").Copy classeurDestination.Sheets("Feuil1").Range("D2")
classeurSource.Sheets("Feuil1").Range("C14").Copy classeurDestination.Sheets("Feuil1").Range("E2")
classeurSource.Sheets("Feuil1").Range("C16").Copy classeurDestination.Sheets("Feuil1").Range("F2")
classeurSource.Sheets("Feuil1").Range("C18").Copy classeurDestination.Sheets("Feuil1").Range("G2")
classeurSource.Sheets("Feuil1").Range("C20").Copy classeurDestination.Sheets("Feuil1").Range("H2")
classeurSource.Sheets("Feuil1").Range("C22").Copy classeurDestination.Sheets("Feuil1").Range("I2")
classeurSource.Sheets("Feuil1").Range("C24").Copy classeurDestination.Sheets("Feuil1").Range("J2")

'fermer le classeur source
classeurSource.Close False

End Sub

5 réponses

  1. Contributeur
    Bonjour

    le principe:

    Sub ccm() 
    Dim fich As String 
    'on force dans le répertoire source 
    ChDir "C:\ficheappel" 
    'on fige le défilement de l'écran 
    Application.ScreenUpdating = False 
     'on réduit la sélection en utilisant un générique  et un joker  *" 
    fich = Dir(ficheappel & "*.xlsm") 
    While fich <> "" 
        'on appelle la macro 
        import fich 
      'affecte le fichier suivant (utilisation du joker " * " utilisé pour la def du 1° fichier) 
        fich = Dir 
    Wend 
    End Sub 
    


    et tu modifies ta macro import ( lignes modifiées uniquement)
    Sub import(fichier) 
    Set classeurSource = Application.Workbooks.Open(fichier, , True) 
    


    Maintenant, tu as pas mal de modif à faire dans cette macro car telle qu'elle est tu écris toujours au m^me endroit dans le classeur destination; il te faut créer une boucle et optimiser car elle est très lente... on pourrait aussi supprimer l'appel à la macro import et faire une seule macro...

    essaies et reviens si tu n'y arrives pas

    :-x
    0
    1. Tout d'abord, merci pour le code, il marche très bien!

      Maitenant, ce qui nous faudrait, c'est pouvoir faire une boucle qui retranscrive les données sur des lignes différentes du tableur excel comme vous nous l'avez fait remarqué.

      Comment peut-on faire?
      Est ce qu'on doit le faire dans la macro ccm ou dans import?
      Est ce qu'on doit faire 2 macros différentes?

      Merci pour votre aide!
      0
      1. Contributeur
        Propose quelque chose et on verra: on aide mais on ne fait pas "à la place de..."

        Dans l'attente
        cordialement
        Michel
        0
    2. Voila ce qu'on a tenté:

      Sub ccm()
      Dim fich As String
      'on force dans le répertoire source
      ChDir "C:\ficheappel"
      'on fige le défilement de l'écran
      Application.ScreenUpdating = False
      'on réduit la sélection en utilisant un générique et un joker *"
      fich = Dir(ficheappel & "*.xlsm")
      For i = 1 To 50
      While fich <> ""

      'on appelle la macro
      Dim classeurSource As Workbook, classeurDestination As Workbook
      'ouvrir le classeur source (en lecture seule
      Set classeurSource = Application.Workbooks.Open(fich, , True)
      'définir le classeur destination
      Set classeurDestination = ThisWorkbook

      'copier les données de la "Feuil1" du classeur source vers la "Feuil1" du classeur destination
      classeurSource.Sheets("Feuil1").Range("C6").Copy classeurDestination.Sheets("Feuil1").Range("Ai+1")

      classeurSource.Sheets("Feuil1").Range("C8").Copy classeurDestination.Sheets("Feuil1").Range("Bi+1")
      classeurSource.Sheets("Feuil1").Range("C10").Copy classeurDestination.Sheets("Feuil1").Range("Ci+1")
      classeurSource.Sheets("Feuil1").Range("C12").Copy classeurDestination.Sheets("Feuil1").Range("Di+1")
      classeurSource.Sheets("Feuil1").Range("C14").Copy classeurDestination.Sheets("Feuil1").Range("Ei+1")
      classeurSource.Sheets("Feuil1").Range("C16").Copy classeurDestination.Sheets("Feuil1").Range("Fi+1")
      classeurSource.Sheets("Feuil1").Range("C18").Copy classeurDestination.Sheets("Feuil1").Range("Gi+1")
      classeurSource.Sheets("Feuil1").Range("C20").Copy classeurDestination.Sheets("Feuil1").Range("Hi+1")
      classeurSource.Sheets("Feuil1").Range("C22").Copy classeurDestination.Sheets("Feuil1").Range("Ii+1")
      classeurSource.Sheets("Feuil1").Range("C24").Copy classeurDestination.Sheets("Feuil1").Range("Ji+1")

      'fermer le classeur source
      classeurSource.Close False
      'affecte le fichier suivant (utilisation du joker " * " utilisé pour la def du 1° fichier)
      fich = Dir

      Wend
      Next i
      End Sub

      On a rassemblé les 2 macros en une seule.
      Ca ne fonctionne pas!
      Pour les valeurs de i, à la place de 50, on aimerais bien avoir "le nombre de dossiers".

      Désolé mais on est vraiment pas doué!
      Merci d'avance!
      0
      1. Contributeur
        Désolé mais on est vraiment pas doué! : on a tous commencé et on continue tous à galérer et apprendre ! :-)

        a complèter de 3 à 10 cellules

        Option Base 1  
        
        Sub importer()  
        '-------déclarations  
        Dim fich As String  
        Dim tablo(10)  
        Dim classeurSource As Workbook, classeurDestination As Workbook  
        Dim cptr As Byte  
        
        '-----initialisations  
        'on force dans le répertoire source  
        ChDir "C:\ficheappel"  
        'on fige le défilement de l'écran  
        Application.ScreenUpdating = False  
        'on réduit la sélection en utilisant un générique et un joker *"  
        fich = Dir(ficheappel & "*.xlsm")  
        cptr = 2  
        
        '------importations  
        While fich <> ""  
            'ouvrir le classeur source (en lecture seule  
            Set classeurSource = Application.Workbooks.Open(fich, , True)  
            'définir le classeur destination  
            Set classeurDestination = ThisWorkbook  
        
            'copier les données de la "Feuil1" du classeur source vers la "Feuil1" du classeur destination  
            'collectes dans la source  
            With classeurSource.Sheets("Feuil1")  
                tablo(1) = .Range("C6").Value  
                tablo(2) = .Range("C8").Value  
                tablo(3) = .Range("C10").Value  
                '.... à complèter  
            End With  
            'restitutions dans destinations  
            With classeurDestination.Sheets("Feuil1")  
                .Range(.Cells(cptr, 1), .Cells(cptr, 10)) = tablo  
            End With  
            'implémente LIGNE de restitution  
            cptr = cptr + 1  
              
            'fermer le classeur source  
            classeurSource.Close False  
            'affecte le fichier suivant (utilisation du joker " * " utilisé pour la def du 1° fichier)  
            fich = Dir  
        Wend  
        
        classeurDestination.Sheets("Feuil1").activate
        
        End Sub  
        
        0
    3. C'est exactement ce qu'on voulait!

      Merci énormément!

      A une prochaine fois peut-être!
      0
      1. On a encore une petite question finalement.

        Nous souhaitons mettre notre tableau récapitulatif des fiches d'appels et les fiches d'appels sur en seveur local.
        On a par conséquent changé l'adresse du classeur source dans la macro (ce n'est plus C:\ficcheappel mais \\Srv-fttmtp\entreprise\ficheappel).
        Néanmoins cela ne fonctionne pas et l'erreur suivante s'affiche

        Erreur d'éxecution '91'
        Variable objet ou variable de bloc With non définie

        et le debogeur nous indique la ligne :

        classeurDestination.Sheets("Feuil1").Activate

        Y a-t-il un problème parce que l'on ne cherche plus sur le disque dur mais sur un réseau?
        Ou sinon d'où vient le problème?

        Merci d'avance
        0
        1. Contributeur
          bonjour,

          c'est possible mais je ne connais plus la syntaxe (je ne suis plus en réseau)

          Il vaudrait mieux que tu relances une discussion sur ce thème
          0
        2. merci du conseil
          0
        3. apparemment cela ne vient pas du réseau.
          Est-ce possible qu'il faille mettre une condition dans le cas où il n'y a plus de fiches appel; du genre

          if fiche = nothing then exit sub?

          merci
          0