Sujet Précédent Sujet Suivant

Itération de macros Excel

Fermé
matmat125 Messages postés 9 Date d'inscription mardi 1 juin 2010 Statut Membre Dernière intervention 4 juin 2010 - 2 juin 2010 à 08:47
matmat125 Messages postés 9 Date d'inscription mardi 1 juin 2010 Statut Membre Dernière intervention 4 juin 2010 - 4 juin 2010 à 11:46
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
A voir également:

5 réponses

Réponse 1 / 5
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
Modifié par michel_m le 2/06/2010 à 09:58
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
Réponse 2 / 5
matmat125 Messages postés 9 Date d'inscription mardi 1 juin 2010 Statut Membre Dernière intervention 4 juin 2010
2 juin 2010 à 10:56
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
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
2 juin 2010 à 11:20
Propose quelque chose et on verra: on aide mais on ne fait pas "à la place de..."

Dans l'attente
cordialement
Michel
0
Réponse 3 / 5
matmat125 Messages postés 9 Date d'inscription mardi 1 juin 2010 Statut Membre Dernière intervention 4 juin 2010
2 juin 2010 à 13:37
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
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
Modifié par michel_m le 2/06/2010 à 14:50
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
Réponse 4 / 5
matmat125 Messages postés 9 Date d'inscription mardi 1 juin 2010 Statut Membre Dernière intervention 4 juin 2010
2 juin 2010 à 16:22
C'est exactement ce qu'on voulait!

Merci énormément!

A une prochaine fois peut-être!
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 5
matmat125 Messages postés 9 Date d'inscription mardi 1 juin 2010 Statut Membre Dernière intervention 4 juin 2010
3 juin 2010 à 11:38
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
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
3 juin 2010 à 13:33
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
matmat125 Messages postés 9 Date d'inscription mardi 1 juin 2010 Statut Membre Dernière intervention 4 juin 2010
3 juin 2010 à 15:33
merci du conseil
0
matmat125 Messages postés 9 Date d'inscription mardi 1 juin 2010 Statut Membre Dernière intervention 4 juin 2010
4 juin 2010 à 11:46
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