Macro import données dans un classeur de synthèse

Bonjour, je suis à la recherche d'un code VBA afin de remplir la fonction suivante, qui est assez simple somme toute.

J'ai plusieurs classeurs excel qui sont remplis régulièrement par plusieurs personnes dans leur coin. Chaque classeur comporte le même onglet, nommé "suivi". Ces classeurs sont harmonisés et se présentent de la manière suivante :

Colonne A : Référence (de type "1a", "1b", "1c" etc. jusqu'à 28c, un nombre définis de références donc)

Colonne B, C etc. : Des informations liées au critère correspondant

Dans un classeur de synthèse je souhaite importer l'ensemble des lignes de chaque onglet "suivi" de tous mes classeurs excel avec une fonction de recherche-tri qui va me copier toutes les lignes du critère 1a de tous les classeurs dans un onglet nommé "1a" dans mon classeur de synthèse, toutes les lignes du critère 1b dans un onglet 1b, etc..

Le but étant, à intervalle régulier, de lancer ma macro pour qu'il génère ce classeur de synthèse comportant autant d'onglets que de critères, avec bien évidemment les colonnes B, C etc des informations liées au critère de l'onglet.

Je ne sais pas si je me suis bien exprimé.

Merci d'avance pour votre aide.

Cdt

Hacka47

Quelqu'un pour de l'aide svp?

Je suis en train de poser une question similaire sur le forum, si j'étais toi, je serai plus explicite en mettant des commentaires sur le fichier excel comme ça, ceux qui sont plus aptes à répondre à ta demande puisse déjà comprendre un minimum sans devoir trop réfléchir.

Bonne chance pour ta demande

Voici quelques pièces jointes pour éclaircir mon propos.

Le contenu du fichier de synthèse a été rentré à la main, mais justement je souhaite que la macro me créée la chose automatiquement, à partir du contenu des fiches 1 et 2.

Merci d'avance

Toujours personne?

Salut,

Je pense qu'en mettant trop vite un deuxième message indiquant que tu n'as pas encore reçu de réponse, soit ça décourage certains membres qui se sentent trop pressés par toi, soit ça fait penser à d'autres que quelqu'un t'a déjà répondu (le compteur des réponses n'est déjà plus sur 0) et ne regardent même pas ton fil. Vu les prix demandés, je pense que tu dois patienter un peu plus.

Je suis tombé par hasard sur ta demande par l'intermédiaire d'une réponse que j'ai faite à Josanche et qui est intervenu sur ton fil.

hacka47 a écrit :

Dans un classeur de synthèse je souhaite importer l'ensemble des lignes de chaque onglet "suivi" de tous mes classeurs excel

A te relire.

EDIT : N'oublie pas non plus de donner suite aux fils que tu ouvres (J'ai été voir ton fil "Courbe tendance de données à partir d'une équation préci")

J'ai un dossier racine dans lequel se trouve plein de dossiers contenant chacun une fiche, et le fichier de synthèse serait créé dans le dossier racine, à côté de mes différents dossiers.

Je pense que quoi qu'il en soit, le code me permettra de modifier le chemin d'accès des fiches et du dossier synthèse non?

Sinon le plus simple est que tout se passe dans le même dossier : les fichiers excel "fiche x" ainsi que le fichier excel "synthèse" au même endroit. On peut partir là-dessus pour le code je pense, ça simplifie les choses au départ.

Merci d'avance

PS: le précédent fils n'a rien donné malheureusement dans ce que je cherchais.

Salut,

Je crois que tu te fous un peu de la gueule du monde

Tu ne m'as recontacté sur ce fil que parce que je t'ai écrit un message privé, autrement tu m'aurais laissé tombé comme une vieille chaussette, comme tu as laissé tomber jmd sur ton fil Courbe tendance de données à partir d'une équation préci.

Et maintenant, tu ne m'avertis pas que tu as lancé la même discussion sur un autre fil, deux heures après m'avoir écrit de continuer à bosser pour toi gratuitement. Heureusement que je m'en suis aperçu à temps.

Tu ne respectes pas plusieurs points de la charte du Forum

Je suis relativement novice sur ce forum, donc tout d'abord je ne me fou de la gueule de personne, en aucun cas. Ce n'est pas l'attitude à adopter lorsque l'on recherche de l'aide. Tu as en effet laisser un message sur mon post...pour m'aider dans mon sujet...je ne vois pas où sont les messages privés?

Et bien évidemment j'aurai continuer à résoudre le problème avec toi...laisser tomber n'est pas dans mon habitude, surtout que c'est moi qui cherche de l'aide par définition, donc j'ai tout à y gagner. Pour l'autre poste, les solutions proposées n'ont rien donné donc je ne vois pas en quoi "j'abandonne".

Ensuite je n'ai pas lancé la même discussion sur un autre fil, j'ai rebondi sur un problème similaire pour obtenir également de l'aide...c'est bien le but de ce site non? Et oui c'est gratuit, et rien ne t'oblige de m'aider si tu juges que je ne le mérite pas...mais bon je ne vois pas en quoi mon attitude est celle d'un profiteur.

A bon entendeur.

Je ne sais plus si je t'ai écrit un message privé ou un mail, mais je t'ai contacté hors Forum afin de te dire que tu ne donnais pas suite à ma proposition d'aide gratuite, alors que tu t'étais plaint que personne ne voulait d'aider.

jmd t'a posé une question afin de résoudre un autre de tes problèmes, tu n'y as jamais répondu.

Tu m'as finalement dit que je pouvais continuer à plancher sur ton problème actuel, mais tu ne m'as pas indiqué que deux heures plus tard tu avais demandé à quelqu'un d'autre de travailler gratuitement pour toi, pour le même souci. Si je m'étais lancé dans cette suite, j'aurais travaillé parfaitement inutilement sans que tu t'en soucies le moins du monde.

Salut

Et bien tu te trompes, je tiens compte de l'aide que toute personne serait prêt à m'apporter. Je n'ai pas vu le mp désolé.

Inutile de continuer à polémiquer, si tu ne veux pas m'aider je n'ai rien à y redire. Merci quand même pour le début de ta démarche.

C'est bon, voici la réponse à mon problème. Un grand merci à Banzai64 pour son aide précieuse.

Option Explicit

Sub ConsolidationFiches()
Dim DLig As Long
Dim sFic As String, sPath As String
Dim Wbk As Workbook, ShtS As Worksheet
Dim Mondico As Object
Dim Tablo
Dim J As Long
Dim Ws As Worksheet

  Application.ScreenUpdating = False
  Set Ws = ActiveSheet

  ' Définir le chemin par défaut
 sPath = ThisWorkbook.Path & "\"
  ' Pour chaque fichier de ce dossier
 sFic = Dir(sPath)
  Do
    ' Au cas ou il s'agisse de ce classeur
   If sFic = ThisWorkbook.Name Then GoTo Suite
    ' Définir le classeur source
   Set Wbk = Workbooks.Open(sPath & sFic)
    ' Définir la feuille source
   Set ShtS = Wbk.Sheets("suivi")
    ' avec ce classeur
   With ThisWorkbook.Sheets("import")
      ShtS.Range("A1:D1").Copy Destination:=.Range("A1")
      DLig = .Range("A" & Rows.Count).End(xlUp).Row + 1
      ShtS.Range("A2:D" & ShtS.Range("A" & Rows.Count).End(xlUp).Row).Copy Destination:=.Range("A" & DLig)
    End With
    Wbk.Close
    ' Effacement des variables objet
  Set ShtS = Nothing: Set Wbk = Nothing
Suite:
    sFic = Dir
  Loop While sFic <> ""

  ' Partie distribution des infos
 Set Mondico = CreateObject("Scripting.Dictionary")
  DLig = Range("A" & Rows.Count).End(xlUp).Row
  For J = 2 To DLig
    Mondico(Range("B" & J).Value) = Range("B" & J).Value
  Next J
  Tablo = Mondico.Items

  For J = 0 To UBound(Tablo)
    If FeuilleExiste(CStr(Tablo(J))) = False Then
      Sheets.Add after:=Sheets(Sheets.Count)
      ActiveSheet.Name = Tablo(J)
    End If
    With Sheets(Tablo(J))
      Ws.Range("A1:D" & DLig).AutoFilter field:=2, Criteria1:=Tablo(J)
      Ws.Range("A1:D" & DLig).SpecialCells(xlCellTypeVisible).Copy .Range("A100")
    End With
  Next J
  Ws.Select
  Ws.Range("A1:D" & DLig).AutoFilter
End Sub

Function FeuilleExiste(nom As String) As Boolean
  On Error Resume Next
  FeuilleExiste = Sheets(nom).Name <> ""
  On Error GoTo 0
End Function

 

Salut,

Je viens de t'envoyer un courriel privé. Regarde éventuellement dans tes spams.

Le message contient quoi? parce que je viens de me rendre compte que mon client de messagerie est paramétré sur la suppression automatique des mails spams...