Centre de pilotage
Bonjour à tous,
Voilà je suis sur un petit outils qui devrait pourvoir me faire gagner du temps surtout si je perd pas trop de temps à le faire
Etat Actuel :
Actuellement j'ai 14 fichiers ( mais cela risque de grandir +++)
Chaque fichier est composer de la même façon, une page d’accueil, et XX onglet. Le nombre d'onglet dépend du nombre de ligne sur la page d'accueil.
Donc je voulais réunir, en quelques sortes les données, voir plus bas, de toute ces pages d'accueil, sur un seul fichier qui devrait me permettre dans un second temps, de corrigé les données puis de les retransmettre, corrigés sur le bon fichier.
si vous avez une idée pour récupérer ceci.
Allez au dernier post pour les fichiers
Bonjour,
Sérieux ? Du code avec un accès mot de passe !!!
ric
Oup's désolé correction du fichier,
désolé pour le mdp c'est pas de mon bon vouloir.... en plus d'un mauvais upload
Alors voilà ce que j'obtiens de mieux,
Sub ListingFichiers()
Dim Rep As String, Fichier As String
Dim i As Integer
Dim Nc, Cel As Range
Rep = ActiveWorkbook.Path & "\Laboratoire hematologie\"
Fichier = Dir(Rep)
Do While Fichier <> ""
i = i + 1
Sheets("Feuil1").Range("A" & i + 2) = Fichier
Fichier = Dir
'Range("A3").Select
For Each Cel In Range("A" & i + 2)
Cel.Value = Trim(Cel.Value) 'supprime espaces
Nc = Len(Cel) 'compte les caractères
Cel.Value = Left(Cel, Nc - 5)
On Error Resume Next
Next Cel
Workbooks.Open (Rep & Fichier)
Workbooks(Fichier).Activate
n = Sheets("Accueil").Range(("B200"), Selection.End(xlUp)).Row
With Sheets("Accueil")
.Range("B11:F" & n).Copy
End With
'Workbook.Close True
Workbooks("Dérive sonde hémato V8.xlsm").Activate
With ActiveSheet
Cells((i + 2), 2).Select
ActiveSheet.Paste
Cells((i + 2), 1).Select
Selection.AutoFill Destination:=Range(Cells((i + 2), 1), Cells((i + n - 9), 1)), Type:=xlFillCopy 'xlFillDefault
End With
i = i + n - 11
Loop
End SubJe penses que l'on peut faire plus propre, mais ca donnera une idée du résultat.
L'idee c'est que dans un second temps je puisse réecrire les données vers la feuille d'origine apres modif, ...
Bon evidemment ma macro d'hier, fonctionnait pas trop mal à la maison, mais là impossible de recuperer les bonnes données correctement sur les 14 fichiers....
pour l'instant j'arrive juste à récuperer les noms des fichiers correctement, je n'arrive pas par contre à récuperer les données dans mes classeurs, sauf pour le premier. j'ai l'impression que la macro ne travaille pas sur les bons onglets
Je vous laisse deux fichiers cibles et le fichier de suivi dans lequelle les données doivent etres copier.
Si une ame charitable peut me regarder celà !
Merci
Bonjour Ric et merci pour ton essais,
Les données qui sont rapatriées ont l'air de fonctionner mais la boucle tourne que sur un seul fichier.
Si tu as une idée pour passer d'un fichier à l'autre. Et j'ai pas compris à quoi servait Z si tu peux ajouter quelques commentaires pour que j'arrive à suivre la macro,
Encore merci
Bonjour,
Pour faire une boucle sur un fichier je t'invite à regarder un sujet similaire auquel j'ai contribué récemment
Le principe c'est de faire une boucle For each dans la collection Files d'un objet Folder (Folder.files), tu parcours ainsi tous les fichiers dans le dossier, tu peux bien sûr passer les fichiers dont tu ne veux pas en regardant la propriété name du fichier
Bonjour à tous,
Désolé pour le premier fichier ...
Celui-ci fonctionne mieux. J'ai utilisé le code que Ausecour nous rappelé.
J'ai aussi dynamisé le nom du fichier source ainsi, peu importe son nom, ça fonctionnera ... il n'y a que son emplacement par rapport au dossier "Laboratoire hematologie" qui doit correspondre.
ric
Cool parfait,
j'étais presque arrivé au même résultat, sauf que je récupère le chemin entier du fichier,
T'as gestion avec
FichSource = ActiveWorkbook.Name! c'est efficace
Franchement super, je tests l'opération inverse maintenant, réécrire les données vers le fichier source mais avec le modèle que tu as fait, cela devrait me permettre d'avancer.
Merci!
Re bonjour le forum,
La deusième étape est quasiment bouclé il me reste un petit probleme, je n'arrive pas à coller les données dans le classeur de destination, il doit y avoir une erreur de syntaxe mais je ne la retrouve pas.
Pour l'instant j'appelle un userform avec la liste des dates sans doublon, dès que la date selectionner concorde avec la date de la cartyographie j'ouvre le fichier correspondant, dans le fichier je recherche le nom de la sonde correspondante et j'aimerai coller les valeurs copier initialement.
Pour mon test, selectionnez dans la listebox les deux dernières valeur (2016)qui doivent corrigées le fichier déjà fournis Modèle extraction v8
J'ai toujurs une erreur de type la methode paste de la classe worksheet à échoué.
Si vous avez une idée je suis ^prenneur !
Merci, à vous
Bonjour,
Dans des cas comme celui-là, j'ajoute temporairement un msgbox pour comprendre ce qui se passe.
Essai ceci, tu vas tout comprendre ...
...
...
For i = 3 To Range("F65536").End(xlUp).Row
d = Sheets("feuil1").Cells(i, 6).Value
MsgBox d & " --- " & .List(j)
...
...ric
Merci Ric,
J'ai essayer là ou cela coinse mais ca m'explique pourquoi la macro refuse de coller.
Le probleme se situe dans l'userform
Range(Cells(i, 4), Cells(i, 6)).Copy '--------> ici je copie pas de probleme si je colle en manuel
Workbooks.Open (rep & F & ".xlsm")
Lig = 11
While (Workbooks(F & ".xlsm").Sheets(1).Cells(Lig, 2).Value <> "")
x = Workbooks(F & ".xlsm").Sheets(1).Cells(Lig, 2).Value
If x = S Then
With Workbooks(F & ".xlsm").Sheets(1)
.Cells(i, 4).Select
.Paste '-------------------> c'est ici que la macro bloque
End With
End If
Lig = Lig + 1
WendBonjour,
Si tu remplaces paste par selection.paste ou bien .selection.paste, ou .activecell.paste , ça marche ou non?
Bonjour,
J'ai choisi une date dans le listbox et cliqué sur le bouton, mais la comparaison ne donne aucun résultat car les deux éléments comparés sont toujours différents ... ce que révèle le msgbox.
Je dois m'absenter quelques heures ...
ric
Etrange, je viens de refaire une batterie de test les comparaisons ne posent aucun probleme, "pour les dates" je suis en format texte pour les deux, pour le nom de la sonde ( colonne B) pas de probleme non plus. je reposte les deux fichiers pour que l'on soit tous sur le meme support.
Rebonjour,
Peut-être avec ça alors :
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range("D1:D5")
ça donnerait :
Range(Cells(i, 4), Cells(i, 6)).Copy '--------> ici je copie pas de probleme si je colle en manuel
Workbooks.Open (rep & F & ".xlsm")
Lig = 11
While (Workbooks(F & ".xlsm").Sheets(1).Cells(Lig, 2).Value <> "")
x = Workbooks(F & ".xlsm").Sheets(1).Cells(Lig, 2).Value
If x = S Then
ActiveSheet.Paste Destination:=Workbooks(F & ".xlsm").Sheets(1).Cells(i, 4)
End If
Lig = Lig + 1
WendSi ça ne marche pas, vérifier que ton Workbooks[....] donne bien un range en mode espion
Ps: j'ai trouvé ça ici :
https://docs.microsoft.com/en-us/office/vba/api/excel.worksheet.paste
Bon Apres 2heures de bouchon et une bonne heure de crise sur toutes les librairy qui ont sauté, et apres avoir recréer tous les fichiers " propre"
Ton code fonctionne bien, j'ai juste modifié le fait que tu le collais à la fin au lieu de remplacer dans les 3 dernières colonnes. je vois pas bien pourquoi mon .paste initiale générai des erreurs. la seule différence c'est tu as utilisé un do while et non juste un while.....
il doit y avoir une différence fondamentale qui m'échappe...
Merci à Ausecour, et un chapeau bas pour toi Ric sans quoi je serai toujours en train de pleurer devant mon code.
Il me reste un ou deux détaille à régler. Je cloture dès que possible.