macro de recherche de données dans un autre fichier

[maxiut]

bonjour,

je dois construire un tableau récapitulant les données présentes dans 52 fichiers excel différents.
ces fichiers sont appelés : "VQ S1" jusqu'à "VQ S52".

dans ces fichiers, il existe déjà un onglet réapitulatif du fichier.
je dois copier ces données vers un autre fichier qui lui récapitule les 52 fichiers différents.

j'ai essayé de copier les valeurs de cellules avec des variables mais celà plante.

si vous pouviez m'aider, (je dispose d'excel 2003)

merci d'avance

Max

 

[youky(BJ)]

Re : macro de recherche de données dans un autre fichier

Bonjour Maxiut,
Afin de faciliter les choses ils nous seraient bon de connaitre la dimension du tableau des onglets "Recapitulatif" sur 52 fichiers cela évite des manips peut être inutiles.
exemple de "A2:F50" ......A savoir si tous les tableaux sont ifdentiques.
Y a t'il des lignes de titre????
A+

 

[youky(BJ)]

Re : macro de recherche de données dans un autre fichier

Re, voici du code à mettre dans un module
Il est évident que le fichier ou tu mets cette macro doit être enregistré auparavant dans le même répertoire que les 52 autres fichiers.
L'orthographe du mot "récapitulatif" doit être identique que le nom des onglets sources, et j'utilise Feuil1 qui est le codename de l'onglet et non pas son nom c'est plus sur si on le renomme, tu peux voir cela en fen^tre des projets en haut à gauche en principe.
Par page je prends de A1 à la derniere ligne de col A et copie jusqu'a Col F1
A tester

Sub RécapGénéral()
'Feuil1 est le CodeName de l'onglet ou sera copiées les données
Dim Wb As Workbook
If MsgBox("Voulez-Vous charger les 52 récap... ", 4 + 32, "Chargement des noms") = vbNo Then Exit Sub
Application.ScreenUpdating = False
Feuil1.Cells.ClearContents 'efface les données précédentes
lig = 0
For k = 1 To 52 'boucle sur les 52
fichier = ThisWorkbook.Path & "\VQ S" & k & ".xls"
Set Wb = GetObject(fichier)
With Wb.Sheets("récapitulatif") 'attention au nom
bas = .[A2].End(xlDown).Row
Feuil1.Range("A" & lig + 1 & ":F" & bas + lig).Value = _
.Range("A1:F" & bas).Value
lig = lig + bas
End With
Wb.Close
Next
Application.ScreenUpdating = True
End Sub

 

[maxiut]

Re : macro de recherche de données dans un autre fichier

Bonjour

merci pour ces premières infos,
j'ai oublié de mettre le fichier joint...toutes mes excuses

et tous les fichiers sont identiques d'un points de vue lignes de titre. par contre il est possible que certains onglets possèdent des lignes supplémentaires selon les évènements

 

[maxiut]

Re : macro de recherche de données dans un autre fichier

Re youky

j'ai essayé d'adapter ton code à mon fichier en ne collant que les cellules de
A5 au bas de la feuille.

je rencontre un problème car quand j'applique la macro, soit il me colle uniquement les lignes de titre 52 fois; soit il me met une erreur de type 1004

je joins le fichier avec l'erreur affichée

si tu sais comment résoudre ce problème

Merci d'avance

 

[youky(BJ)]

Re : macro de recherche de données dans un autre fichier

Bonjour Maxuit,
voici la macro avec toute petite modif
double apostophes signifie que j'ai modifié.
Un exemple de la scructure d'une feuille "résumé actions non effectuées"
serai d'une bonne aide.

Sub RécapGénéral()
'Feuil1 est le CodeName de l'onglet ou sera copiées les données

Dim Wb As Workbook
If MsgBox("Voulez-Vous charger les 52 récap... ", 4 + 32, "Chargement des noms") = vbNo Then Exit Sub
Application.ScreenUpdating = False

Range("A5:E36000") = "" 'efface les données précédentes

lig = 4 ''4 au lieu de 0
For k = 1 To 52 'boucle sur les 52

fichier = ThisWorkbook.Path & "\VQ S" & k & ".xls"
'la feuille "résumé actions non effectuées"
'doit exister dans les 52 fichiers et attention, accent et espace
Set Wb = GetObject(fichier)
With Wb.Sheets("résumé actions non effectuées") 'attention au nom

'bas = .[A5].End(xlDown).Row 'si A6 vide ca va pas plus loin
bas = .[A65536].End(xlUp).Row ' voir si colA est celle toujours remplie
Feuil1.Range("A" & lig + 1 & ":F" & bas + lig).Value = _
.Range("A5:F" & bas).Value ''ici j'ia mis A5 au lieu A1
lig = lig + bas
End With
Wb.Close
Set Wb = Nothing ''libere l'objet de la mémoire
Next

Application.ScreenUpdating = True
End Sub

 

[maxiut]

Re : macro de recherche de données dans un autre fichier

Re Youky,

Merci bien
je vais tester ton code.
je joins un exemple de fichier avec l'onglet"résumé actions non effectuées"

 

[maxiut]

Re : macro de recherche de données dans un autre fichier

Re re

je viens de tester ton code, il marche nikel : merci encore

si je peux me permettre de te redemander un truc :

quand j'extrais les valeurs en lançant la macro, sa va bien chercher les valeurs demandées, mais quand il n'y a rien à copier sa affiche "#NA"
j'arrive pas à supprimer ceci

je pensais refaire une macro pour virer tout ce qui ressemble pas à du texte, mais je sais pas trop si sa fera pas trop lourd après

encore merci

 

[youky(BJ)]

Re : macro de recherche de données dans un autre fichier

voici la recif....
je suprime toutes les lignes où en col A ce n'est pas une date
Il ne restera que la 1ere ligne de titre en ligne 5

Sub RécapGénéral()
'Feuil1 est le CodeName de l'onglet ou sera copiées les données
Dim Wb As Workbook
If MsgBox("Voulez-Vous charger les 52 récap... ", 4 + 32, "Chargement des noms") = vbNo Then Exit Sub
Application.ScreenUpdating = False
Range("A5:E36000") = "" 'efface les données précédentes
lig = 4
For k = 1 To 52 'boucle sur les 52
 fichier = ThisWorkbook.Path & "\VQ S" & k & ".xls"
 Set Wb = GetObject(fichier)
  With Wb.Sheets("résumé actions non effectuées") 'attention au nom
  bas = .[A65536].End(xlUp).Row ' voir si colA est celle toujours remplie
  Feuil1.Range("A" & lig + 1 & ":F" & bas + lig).Value = _
  .Range("A5:F" & bas).Value ''ici j'ia mis A5 au lieu A1
  lig = lig + bas
  End With
 Wb.Close
 Set Wb = Nothing ''libere l'objet de la mémoire
Next
For k = Feuil1.[A65536].End(3).Row To 5 Step -1
    If Not IsDate(Cells(k, 1)) Then Rows(k).Delete
Next
Application.ScreenUpdating = True
End Sub

 

[maxiut]

Re : macro de recherche de données dans un autre fichier

Merci pour tout Youky sa marche parfaitement bien

encore merci et longue à vie à XLD