Copier même information d'un dossier

Bonjour,

Je viens vers vous afin de trouver un problême assez urgent a résoudre.

Je vais essayer d'être le plus clair possible.

J'ai un dossier, contenant 400 fiches clients. Ces 400 fiches clients sont toutes dans le même format. Je souhaiterais pouvoir récupérer des informations contenu dans le fichier client afin de crée un fichier unique, avec les informations qui m'interessent.

Je souhaite récuperer a chaque fois les mêmes information.

Je suis casi-sur que cette opération est possible grace à l'utilisation d'une macro. Cependant j'ai peu de connaissance dans ce sujet.

Je travaille sous Excel 2003;

En vous remerciant.

Je reste bien entendu a votre disposition si vous avez besoin de plus de précision pour comprendre mon problême.

Bonjour Darkad69

C'est certainement faisable en VBA, mais pour cela il nous faudrait un exemple de fiche (sans information confidentielle)

et ton fichier de destination avec les colonnes que tu souhaites avoir

A+

Tout d'abord, merci de l'attention porté a mon probleme.

Je n'ai pas la possibilité actuellement d'acceder a mes fichiers, mais je le ferait dès demain matin, en esperant que vous pourrez m'aider.

Merci encore.

Bonjour,

voila l'exemple de la fiche que j'ai( J'en ai 400 exactement de même format dans un même dossier ) et l'exemple du tableau que je voudrais faire.

Merci.

11exemple-tableau.xls (13.50 Ko)
15exemple-fiche.zip (19.43 Ko)

Bonsoir Darkad69

Voici le code à mettre dans un module de ton classeur contenant le tableau récap

Option Explicit

Sub ConsolidationFiches()
  Dim DLig As Long
  Dim sFic As String, sPath As String
  Dim Wbk As Workbook, ShtS As Worksheet
  ' 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("CALCUL MONTANT A PAYER")
    ' avec ce classeur
    With ThisWorkbook.Sheets("Feuil1")
      DLig = .Range("A" & Rows.Count).End(xlUp).Row
      .Range("A" & DLig + 1) = ShtS.Range("B5")
      .Range("B" & DLig + 1) = ShtS.Range("E5")
      .Range("C" & DLig + 1) = CDate(ShtS.Range("C7"))
      .Range("D" & DLig + 1) = ShtS.Range("F1")
      .Range("E" & DLig + 1) = Val(ShtS.Range("B42")) + Val(ShtS.Range("D42"))
      .Range("F" & DLig + 1) = Val(ShtS.Range("C42")) + Val(ShtS.Range("E42"))
      .Range("G" & DLig + 1) = Val(ShtS.Range("D60"))
      .Range("H" & DLig + 1) = Val(ShtS.Range("E60"))
      .Range("I" & DLig + 1) = Val(ShtS.Range("D96"))
      .Range("J" & DLig + 1) = Val(ShtS.Range("D104"))
    End With
    Wbk.Close
    ' Effacement des variables objet
    Set ShtS = Nothing: Set Wbk = Nothing
Suite:
  sFic = Dir
  Loop While sFic <> ""
End Sub

Par défaut le dossier qui sera utilisé pour tous les fichiers est celui du tableau récap

Mais tu peux paramétrer au niveau de la variable sPath

sPath = "Lecteur:\Dossier\Sous-dossier\"

Ne pas oublier le dernier anti-slash

A+

J'ai un problème un peu similaire. J'ai utilisé le code proposé par BrunoM45, mais je souhaiterai le modifier légèrement pour que dans la colonne A, il me copie l'ensemble de la colonne B, et non juste B5 par exemple...idem pour la colonne B, qu'il me copie l'ensemble de la colonne E, et non juste E5...j'ai modifié donc le code comme suit :

Option Explicit

Sub ConsolidationFiches()
  Dim DLig As Long
  Dim sFic As String, sPath As String
  Dim Wbk As Workbook, ShtS As Worksheet
  ' 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("Feuil1")
      DLig = .Range("A" & Rows.Count).End(xlUp).Row
      .Range("A" & DLig + 1) = ShtS.Range("A:A")
      .Range("B" & DLig + 1) = ShtS.Range("B:B")
      .Range("C" & DLig + 1) = ShtS.Range("C:C")
      .Range("D" & DLig + 1) = ShtS.Range("D:D")
    End With
    Wbk.Close
    ' Effacement des variables objet
   Set ShtS = Nothing: Set Wbk = Nothing
Suite:
  sFic = Dir
  Loop While sFic <> ""
End Sub

Et là, erreur 1004 qui apparaît. Comment ça se fait?

Bonjour

D'après ce que je comprends tu veux copier les colonnes A à D

essayes ce code (non testé)

Option Explicit

Sub ConsolidationFiches()
  'Dim DLig As Long
  Dim sFic As String, sPath As String
  Dim Wbk As Workbook, ShtS As Worksheet
  ' 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("Feuil1")
    ShtS.Columns("A:D").Copy .Range("A1")
'      DLig = .Range("A" & Rows.Count).End(xlUp).Row
'      .Range("A" & DLig + 1) = ShtS.Range("A:A")
'      .Range("B" & DLig + 1) = ShtS.Range("B:B")
'      .Range("C" & DLig + 1) = ShtS.Range("C:C")
'      .Range("D" & DLig + 1) = ShtS.Range("D:D")
    End With
    Wbk.Close
    ' Effacement des variables objet
  Set ShtS = Nothing: Set Wbk = Nothing
Suite:
  sFic = Dir
  Loop While sFic <> ""
End Sub

Il me copie bien l'ensemble des données dans les colonnes, mais uniquement d'un seul fichier.

De base j'ai plusieurs classeurs excel : fiche1.xls, fiche2.xls etc. dans un même dossier.

Le but du code est d'importer les données contenues dans ces fiches (sous l'onglet "suivi"), chaque fiche étant similairement construite de 4 colonnes et d'un nombre aléatoire de ligne.

Et le fichier de synthèse devrait contenir l'ensemble des données de chaque onglet suivi de chaque fiche.

Avec le présent code modifié, ça ne copie que les données de ma fiche 1, et rien des autres fiches...? Tu vois mon problème ou pas?

Bonjour

Ta demande

hacka47 a écrit :

dans la colonne A, il me copie l'ensemble de la colonne B, et non juste B5 par exemple...idem pour la colonne B, qu'il me copie l'ensemble de la colonne E, et non juste E5..

Tu n'avais pas parlé de partie de colonne

A essayer

Option Explicit

Sub ConsolidationFiches()
Dim DLig As Long
Dim sFic As String, sPath As String
Dim Wbk As Workbook, ShtS As Worksheet
  ' 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("Feuil1")
      DLig = .Range("A" & Rows.Count).End(xlUp).Row + 1
      ShtS.Range("A1: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 <> ""
End Sub

Si pas ça, fournis au moins 2 fichiers de données

A priori il détecte une erreur d'exécution avec ce code.

Je te joins 2 fichiers de données, ainsi que le fichier de synthèse.

Quelque soit le nombre de données dans les fiches, je souhaiterai qu'elles se retrouvent toutes dans le fichier de synthèse, dans un onglet unique et dans la colonne adéquate.

PS: Idéalement, à terme, ce serait qu'au lieu de tout rassembler dans un seul onglet du fichier de synthèse, qu'il me créé autant d'onglet que de critère (chaque onglet portant la référence d'un onglet unique), avec les colonnes descriptives correspondantes uniquement au critère de l'onglet considéré.

Je ne sais pas si je suis bien clair. Je peux bien évidemment apporter des compléments d'informations.

Merci d'avance.

4fiche1.xlsx (10.33 Ko)
6fiche2.xlsx (9.90 Ko)
6synthese.xlsm (15.02 Ko)

Bonjour

L'erreur venait du nom de la feuille du fichier Synthèse

Modification pour ne pas prendre les entêtes

J'ai déplacé la macro vers un module standard

A voir

Bon alors a priori c'est bon, j'avais changé le nom de l'onglet du fichier de synthèse, donc du coup ça me renvoyer une erreur. J'ai juste modifié en partant de A2 et non A1 sinon il me copie les entêtes de colonne.

Ma question est la suivante maintenant, au lieu de générer un tableau complet de synthèse tous critères confondus, est-il possible de générer plusieurs onglets (dont chaque nom d'onglet correspond à un critère) et qui ne contient donc chacun que les lignes le concernant?


Oops je n'avais pas vu ton dernier post en page 2

Quoi qu'il en soit je vois que nous avons trouvé les même problèmes...je me sens moins con d'un coup. Un grand merci à toi.

Peux-tu juste me dire si VBA permet la création automatique d'onglet dans le fichier synthèse en fonction des références de mes colonnes A de mes fiches?

Bonjour

Version à tester

Un grand merci pour cette modification du code.

Je viens de faire le test.

Voici ce que ça donne :

dans le fichier de synthèse, il y a eu création de 4 onglets : critères, descriptif1, descriptif2, descriptif c.

Chaque onglet comporte uniquement la colonne contenant les données relatives au nom de l'onglet.

CAD:

  • la colonne Critères est entièrement copier en colonne A de l'onglet Critères
  • la colonne Descriptif 1 est entièrement copiée en colonne A de l'onglet Descriptif 1
etc.

Ce que je souhaite est différent, c'est que soit généré des onglets intitulés 1a, 1c, 2a etc. et que chaque onglet ne comportent que les lignes de données du nom de l'onglet créé.

CAD:

  • onglet 1a : uniquement les critères 1a en colonne A, le descriptif 1 des critères 1a en colonne B, le descriptif 2 des critères 1a en colonne C, le descriptif C des critères 1a en colonne D
  • onglet 2a : uniquement les critères 2a en colonne A, le descriptif 1 des critères 2a en colonne B, le descriptif 2 des critères 2a en colonne C, le descriptif C des critères 2a en colonne D

C'est légèrement différent, et ne suis pas sûr que ça puisse être automatisé.

Bonjour

Tu prépares un fichier avec ce que tu veux obtenir exactement

Et je verrai si j'en suis capable

Car pour le moment je n'ai rien compris

Voici le contenu des fiches 1 et 2.

Ainsi que le fichier de synthèse, comprenant la répartition des onglets suivant ce que j'expliquais un peu mal avant.

En gros il faudrait que la macro cherche toutes les données des fiches 1 et 2, et répartissent ces lignes de données dans des onglets spécifiques à chaque critère.

Merci d'avance pour le temps que tu passes sur mon problème.

11fiche1.xlsx (10.25 Ko)
8fiche2.xlsx (9.88 Ko)
12synthese.xlsm (10.78 Ko)

Petite information supplémentaire, étant donné que j'ai des informations manuelles à rajouter dans les onglets de chaque critère, je pense qu'il est plus judicieux que je créé moi-même les onglets de chaque critère manuellement dans mon fichier de synthèse. En revanche je souhaite que soient importées automatiquement toutes les lignes de données des fiches dans l'onglet correspondant du fichier de synthèse, et ce à partir de la ligne 100 (je me réserve les 99 premières lignes pour des données manuelles).

Dans le code donc, il est inutile de demander à la macro de créer les onglets correspondants à chaque critère, puisqu'ils existeront déjà (via une création manuelle), en revanche l'automatisation doit avoir lieu dans la répartition de toutes mes données à partir de la ligne 100, et dans chaque onglet correspondant au critère.

Du genre [si dans une fiche : critère = 1a dans une ligne de données, alors copier cette ligne dans l'onglet 1a du fichier de synthèse à la ligne 101, puis si critère = 1a dans une autre ligne de données, alors copier cette autre ligne dans l'onglet 1a à la suite de la ligne précédente (à savoir ligne 102). etc.] et ce pour toutes les lignes de données de mes fiches.

(Voir mon nouveau fichier synthèse ci-joint).

13synthese.xlsm (27.66 Ko)

Bonjour

A tester

ça se rapproche ça se rapproche 2 derniers éléments si je puis me permettre :

Dans le code ci-dessous, à quel endroit paramétrer les éléments suivants :

- changer de référence colonne Critères (ex: dans mes fiches mes références se trouvent toujours en colonne A, mais comment changer le code pour qu'il me créé les onglets à partir non plus de la colonne A de chaque fiche, mais la colonne B par exemple.)

- changer de début de ligne dans le dispatching dans chaque onglet (ex: je souhaite que mes lignes de données ne commencent qu'à la 101e ligne de chaque onglet, en ayant une automatisation du remplissage de la 100e ligne par la même entête : critères, descirptif1 descirptif 2 descriptif C (voir mon dernier fichier synthèse posté) :

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("A" & J).Value) = Range("A" & 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:=1, Criteria1:=Tablo(J)
      Ws.Range("A1:D" & DLig).SpecialCells(xlCellTypeVisible).Copy .Range("A1")
    End With
  Next J
  Ws.Select
  Ws.Range("A1:D" & DLig).AutoFilter
  Columns("A:D").Clear
End Sub

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

Bonjour

hacka47 a écrit :

changer de référence colonne Critères (ex: dans mes fiches mes références se trouvent toujours en colonne A, mais comment changer le code pour qu'il me créé les onglets à partir non plus de la colonne A de chaque fiche, mais la colonne B par exemple.)

Dans la colonne B (déjà pas évident) tu as plusieurs noms pour le même critère de la colonne A

On fait un tirage au sort ?

hacka47 a écrit :

- changer de début de ligne dans le dispatching dans chaque onglet (ex: je souhaite que mes lignes de données ne commencent qu'à la 101e ligne de chaque onglet, en ayant une automatisation du remplissage de la 100e ligne par la même entête : critères, descirptif1 descirptif 2 descriptif C (voir mon dernier fichier synthèse posté) :

Tu me traduis s'il te plait, je viens de regarder ton dernier fichier et rien à la 100ème ligne, les entêtes ne me semblent pas être dans un autre ordre que celui résultant de la macro

Rechercher des sujets similaires à "copier meme information dossier"