Choisir son dossier selon le mois

Le 17/06/2013 à 14:22

Bonjour,

J'ai cherché un peu partout et j'ai trouvé un code à mon problème sauf que j'ai une erreur sur celui-ci que je ne sais résoudre.

Je ne vois pas comment la modifier.

J'explique déjà ce que je souhaites :

J'ai un fichier excel ou je dois copier des onglets d'autres fichiers.

Ces fichiers seront dans des dossiers constituer par mois (ex: 01-janvier, 02-février, 03-mars, ect ...).

J'ai fait un code qui ouvre un InputBox, celui-ci je veux (c'est la que j'ai une erreur) que quand j'écris le mois (exemple "mars"), je veux qu'il ouvre le dossier "03-mars".

Après le code copie tous les onglets dont le nom comporte le mois "mars".

voici le code que j'ai :

 
Option Explicit
Public Chemin$
Option Compare Text

Sub Importer()
    Dim i&, fin&, a&, rep$, wbks As Workbook, wbkc As Workbook, x$, ws As Worksheet
    ', Nomdossier As String

    Chemin = ThisWorkbook.Path

    Set wbkc = ThisWorkbook
    rep = Application.InputBox("Quel mois Souhaitez vous Importer?" & vbCrLf & _
                               "Entrer le mois à Importer")
If rep = "Faux" Then Exit Sub
    Application.ScreenUpdating = 0
    Call Liste
    fin = Sheets("Liste").Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To fin
        If Not Sheets("Liste").Cells(i, 1) Like "*" & "Fichier" & "*" Then
            x = Sheets("Liste").Cells(i, 1)
            Set wbks = Workbooks.Open(Chemin & "\" & x) 
'J AI UN MESSAGE D'ERREUR ICI CAR LE FICHIER EXCEL N'EST PAS DANS LE DOSSIER (MARS)
' JE NE VOIS PAS COMMENT DIRE QUE x est la recherche du fichier et x est également le dossier mars)
            For Each ws In wbks.Worksheets
                If ws.Name Like "*" & rep & "*" Then ws.Cells.Copy: GoTo 1
            Next ws

1           wbkc.Activate
            wbkc.Sheets.Add after:=Sheets(Sheets.Count): ActiveSheet.Name = Split(x, ".")(0) & " " & rep
            ActiveSheet.Paste
            Application.DisplayAlerts = 0
            wbks.Close 0
            Application.DisplayAlerts = 1
        End If
    Next i
    Application.DisplayAlerts = 0
    Sheets("Liste").Delete
    Application.DisplayAlerts = 1
End Sub

Option Explicit
Option Compare Text

Sub Liste()
    Dim Fso As Object
    Dim MonRepertoire As String, f As Object, x As Integer
    Dim f1 As Object, f2 As Object
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Sheets.Add after:=Sheets(Sheets.Count): ActiveSheet.Name = "Liste"
    MonRepertoire = Chemin
    x = 1
    For Each f1 In Fso.GetFolder(MonRepertoire).SubFolders
        Cells(x, 1).Value = f1.Name
        x = x + 1
        For Each f2 In f1.Files
            Cells(x - 1, 2).Value = f2.Name
            x = x + 1
        Next f2
        'x = x - 1
    Next f1
End Sub

Je vous remercie par avance pour toute aide apportée ...

mimi

Le 17/06/2013 à 14:52

Bonjour

Il faudrait expliquer un peu mieux

mimi28 a écrit :

Ces fichiers seront dans des dossiers constituer par mois (ex: 01-janvier, 02-février, 03-mars, ect ...).

Ce sont les noms des dossiers(répertoires) : Exact ?

mimi28 a écrit :

je veux qu'il ouvre le dossier "03-mars".

Tu veux ouvrir le répertoire "03-mars" : Exact ?

mimi28 a écrit :

Après le code copie tous les onglets dont le nom comporte le mois "mars".

Les onglets de quoi , tu n'as pas ouvert de fichier ?

Détailles l'arborescence afin de comprendre ce que tu cherches

Exemple

  • Fichier avec macro
  • Repertoire (01-Janvier)
    fichier (......)
    fichier ( .......)
    etc....
  • Répertoire (02-Février)
    Fichier (......)
    etc ....
    etc ....
Le 17/06/2013 à 15:17

Bonjour Banzai,

merci de me répondre aussi rapidement.

Effectivement, je ne suis pas très douée dans les termes techniques (surtout vba).

Je te joins le fichier source dans l'onglet synthese j'ai mis l'arborescence des répertoires.

En fait, le but est de copier tous les onglets dans le fichier source. Mais chaque fichier à le même nom que son onglet.

Je te remercie d'avance

21analyse-retour-bis.xlsm (118.03 Ko)

J'ai oublié le fichier

Le 17/06/2013 à 15:57

Bonjour

Que je comprenne un peu mieux, parce que j'ai du mal

Exemple:

Le mois tapé est "Mars"

Tu regardes dans tous les répertoires (sauf celui contenant le mot "fichier")

Tu ouvres dans ce répertoire le fichier "03-mars" et ...... après je ne sais pas

Pas évident tant que tu ne connais pas l'organisation et la structure des fichiers de comprendre

Détailles bien la succession des opérations faites lorsque l'on écrit un mois dans la boite de dialogue jusqu'à la fin de la macro

Le 17/06/2013 à 16:15

sorry

En fait, voila ce que fait la macro initial :

elle liste le répertoire où se trouve le fichier synthèse (macro lister)

ensuite, elle ouvre tous les fichiers excel dont le nom de l'onglet a été inscrit dans le Inputbox (message "mars")

après avoir trouver elle copie ces onglets dans le fichier synthèse.

Moi, je souhaites que la macro :

ouvre un message inputbox

que je sélectionne le mois du répertoire ou doit être effectuer la recherche des fichiers xls

et après que ces onglets soient recopier dans mon fichier de synthèse.

J'espère avoir pu être le plus explicite possible

merci encore

Le 17/06/2013 à 16:32

Bonjour

Désolé mais là tu me perds

mimi28 a écrit :

ensuite, elle ouvre tous les fichiers excel dont le nom de l'onglet a été inscrit dans le Inputbox (message "mars")

Çà veut dire quoi ?

Elle ouvre tous les fichiers, regarde si le nom d'un onglet du fichier correspond au nom tapé dans l'inputbox, si oui elle copie cet onglet dans le fichier synthèse

Je suis désolé mais je ne pige pas

Tu connais à fond ton programme, mais moi j'en suis loin

mimi28 a écrit :

ouvre un message inputbox

que je sélectionne le mois du répertoire ou doit être effectuer la recherche des fichiers xls

Cela je le comprends, tu veux regarder directement et seulement dans le répertoire (exemple "03-mars")

Mais une fois dans ce répertoire que fais tu ?

Ce que j'ai marqué (ouverture de tous les fichiers, vérification si un onglet s'appelle "03-mars", et si oui on copie cet onglet)

Et une fois la vérification de tous les fichiers de ce répertoire : fin de la macro

Le 17/06/2013 à 16:46

Encore désolée si me m'explique mal mais tu n'es pas loin.

Elle ouvre tous les fichiers, regarde si le nom d'un onglet du fichier correspond au nom tapé dans l'inputbox, si oui elle copie cet onglet dans le fichier synthèse

oui, la macro ouvre tous les fichiers dans le même chemin (avec ThisWorkbooks.path) et si elle trouve un onglet ayant le mot "mars", celui est copier dans le fichier de synthèse.

et la je le comprends, tu veux regarder directement et seulement dans le répertoire (exemple "03-mars")

oui c'est ca

Mais une fois dans ce répertoire que fais tu ?

Ce que j'ai marqué (ouverture de tous les fichiers, vérification si un onglet s'appelle "03-mars", et si oui on copie cet onglet)

Et une fois la vérification de tous les fichiers de ce répertoire : fin de la macro

Oui, ouvrir les fichiers excel du repertoire "03-mars" et rechercher et copier tous les onglets ayant "mars" dans son nom d'onglet.

et fin de macro

Le 17/06/2013 à 18:25

Bonjour

Normalement il manque le nom des nouvelles feuilles

A tester et à dire

42mimi28-analyse-retour-v001.xlsm (123.77 Ko)
Le 20/06/2013 à 10:59

Bonjour,

Désolé de ne répondre que maintenant mais je viens de tester ton fichier et rien ne se passe.

Et lorsque je copie le code sur mon fichier il bug.

J'ai fais le pas à pas et en fait, il ouvre le fichier mais ne le copie pas l'onglet dans le fichier synthèse.

Merci déjà ta correction recherche déjà dans le bon dossier.

Le 20/06/2013 à 11:08

Bonjour

Il faut que tu transmettes un fichier pour savoir la structure et surtout le nom des feuilles

Le 20/06/2013 à 11:35

C'est bon, j'ai un peu modifier la fin de ton code et maintenant ca fonctionne.

voici le code qui fonctionne :

Option Explicit
Option Compare Text

Sub ImporterOnglet()
Dim Fichier As String, Chemin As String, Rep As String
Dim LeMois As Byte, I As Integer
Dim Ws As Worksheet, WsActif As Worksheet
Dim wbks As Workbook, wbkc As Workbook

  Set WsActif = ActiveSheet

  Application.DisplayAlerts = False
  For I = Sheets.Count To 4 Step -1
    Sheets(I).Delete
  Next I
  Application.DisplayAlerts = True

  Rep = InputBox("Quel mois Souhaitez vous Importer?" & vbCrLf & _
                               "Entrer le mois à Importer")
  If Rep = "" Then Exit Sub

  ' attention chaque nom de mois doit avoir 9 caractères
  '                  123456789123456789123456789123456789123456789123456789123456789123456789123456789123456789123456789123456789
  LeMois = InStr(1, "janvier  fevrier  mars     avril    mai      juin     juillet  aout     septembreoctobre  novembre decembre ", Rep)

  If LeMois = 0 Then
    MsgBox "Nom du mois non conforme"
    Exit Sub
  End If

  Application.ScreenUpdating = False

  Chemin = ThisWorkbook.Path & "\" & Format(1 + ((LeMois - 1) \ 9), "00") & " - " & UCase(Rep) & "\"

  Fichier = Dir(Chemin & "*.xls*") 'j'ai mis une étoile pour tout type de fichier xlsx,xlsm,xls
  Do While Fichier <> ""    ' Commence la boucle
    With Workbooks.Open(Chemin & Fichier)
      For Each Ws In Sheets
        If Ws.Name Like "*" & Rep & "*" Then
          Ws.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

            Application.DisplayAlerts = False 'rajout

         Application.DisplayAlerts = True 'rajout

          Exit For
        End If
      Next Ws
   .Close
      Application.ScreenUpdating = True 'rajout

    End With
    Fichier = Dir
  Loop
  'WsActif.select => j'ai retiré j'avais un message d'erreur
End Sub

Encore merci pour ton aide Banzai

Rechercher des sujets similaires à "choisir dossier mois"