sélection partie de nom de fichier

Version imprimable

Bonjour à tous et toutes,

je souhaite automatiser la mise en forme de fichiers que je reçois chaque mois. Je copie/colle des parties de ces fichiers "bruts" vers des fichiers "mis en forme". Comme je suis ultra débutant j'ai enregistré une macro que je vous copie ci-dessous:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 Sub test() ' ' test Macro ' ' Windows("acc juin 2011.xls").Activate Range("A1:H13").Select Selection.Copy Application.WindowState = xlMinimized Windows("TRANSIT EN FORME.xls").Activate Sheets("acc").Select Range("A1").Select ActiveSheet.Paste Windows("achats juin 2011.xls").Activate Range("A1:G11").Select Application.CutCopyMode = False Selection.Copy Application.WindowState = xlMinimized Windows("TRANSIT EN FORME.xls").Activate Sheets("achats").Select Range("A1").Select ActiveSheet.Paste End Sub
comme chaque mois le nom des fichiers source gangent, comment puis je faire pour que la macro ignore une partie du nom du fichier. Dans le cas ci-dessus ignorer "juin 2011" ou autre possibilité ne prendre que les 5 premières lettres du nom du fichier.

Pouvez vous m'aider? D'avance grand merci.
Djepi

Edité 25/09/11 à 23h36 Désolé pour le non emploi de la balise code.

24/09/2011, 11h25
PolyAmide

Je pense qu'un "like" avant la partie de nom du fichier qui t’intéresse peut être une solution.

Pour plus d'infos l'aide VBA est assez bien faite:

tape like sur n'importe quelle ligne de vba, surligne avec la souris et appuie sur F1

Bonjour,

Essaie comme ceci (je n'ai pas retouché autrement ton code qui pourrait être simplifié) :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub test()
'
' test Macro
'
 
'
Dim w As Window, i As Integer
For i = 1 To Windows.Count
    If Left(Windows(i).Caption, 4) = "acct" Then
        Set w = Windows(i)
    End If
Next i
w.Activate
Range("A1:H13").Select
Selection.Copy
Application.WindowState = xlMinimized
Windows("TRANSIT EN FORME.xls").Activate
Sheets("acc").Select
Range("A1").Select
ActiveSheet.Paste
w.Activate
Range("A1:G11").Select
Application.CutCopyMode = False
Selection.Copy
Application.WindowState = xlMinimized
Windows("TRANSIT EN FORME.xls").Activate
Sheets("achats").Select
Range("A1").Select
ActiveSheet.Paste
End Sub

Bonjour,

Teste ce qui suit mais attention, les 2 feuilles du classeur copié doivent se nommer "acc" et "achats", adapte si ce n'est pas le cas car dans ta macro les feuilles copiées ne sont pas précisées :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
 
Sub test()
 
    Dim Cl As Workbook
    Dim ClForme As Workbook
 
    Set ClForme = Workbooks("TRANSIT EN FORME.xls")
 
    'attention, pour le classeur copié, les feuilles se nomment "acc" et "achats"
    'à adapter
    For Each Cl In Workbooks
 
        If InStr(Cl.Name, "acc") <> 0 Then
 
            Cl.Worksheets("acc").Range("A1:H13").Copy ClForme.Worksheets("acc").Range("A1")
 
        End If
 
        If InStr(Cl.Name, "achats") <> 0 Then
 
            Cl.Worksheets("achats").Range("A1:G11").Copy ClForme.Worksheets("achats").Range("A1")
 
        End If
 
    Next cel
 
End Sub

Hervé.

24/09/2011, 17h54
djepi

sélection partie de nom de fichier

merci Polyamide,Daniel et Theze pour vos réponses.

Polyamide, je suis encore trop débutant et je n'ai pas encore eu le temps nécessaire mais je n'ai pas su mettre la solution "like" en route.

Daniel j'ai essayé de faire fonctionner ta macro mais j'ai un message :erreur
d'exécution '13' incompatibilité de type et c'est la ligne set w=windows(i) qui est surlignée.

Thèse j'ai modifié le nom des feuilles comme tu le demandais et tout marche très bien. Grand merci. Si je peux encore poser une question j'aimerais que tu m'indiques comment il faut modifier ta macro si le fichier excel 'Transit en forme.xls' se trouve à l'adresse C:\mes documents\DEVOK alors que tous les autres fichiers excel (acc, achats, etc...) se trouvent à l'adresse C:\mes documents\DEVBRUT .
D'avance merci pour l'aide précieuse.
Djepi
25/09/2011, 09h46
Theze

Bonjour,

Donc, si j'ai bien compris, tu souhaiterais ouvrir les classeurs automatiquement ?
Indique nous avec assez de précisions la marche à suivre afin de ne pas te donner des réponses erronées qui finiront par semer la pagaille.

Hervé.
25/09/2011, 12h07
djepi

Sélection partie de nom de fichier

Bonjour le forum, bonjour Hervé, merci pour l'aide.

Je voudrais d'abord redire que les seules macros que j'ai jamais faites sont celles qui proviennent de l'enregistreur de macros de excel. D'avance donc désolé lorsque je ne comprends pas assez vite.

Hervé, comme demandé, voilà la séquence exacte de ce que je fais aujourd'hui de façon non automatique et que j'aimerais automatiser au maximum:
1)je vais à l'adresse C:\mes documents\DEVOK et là j'ouvre le fichier "transit en forme.xls" (c'est dans ce fichier que je voudrait ultérieurement enregistrer la macro)
2)je vais à l'adresse C:\mes documents\DEVBRUT et là se trouvent 5fichiers: "achats 08.2011.xls","aci 08.2011.xls","acu 08.2011.xls","bal 08.2011.xls" et "jour 08.2011.xls" (ces fichiers changent de date tous les mois mais grace à ta macro je peux maintenant ignorer cette partie du nom de fichier)
2a)j'ouvre ces 5 fichiers.
2b)dans chacun de ces 5 fichiers je copie une portion (A1:M275) de la feuille intitulée "sheet1" (ces fichiers n'ont qu'une seule feuille sauf "bal xx" où je dois prendre le dernier onglet de droite)
2c)je colle ces différentes parties de feuilles dans la cellule B1 du fichier "transit en forme.xls" (ouvert dans le point 1) dans respectivement les onglets "achats", "aci", "acu", "bal" et "jour".
2d)je referme les 5 fichiers.
Voilà la description détailée de ce que je fais.
Merci de bien vouloir m'aider.

Djepi

Bonjour,

Tu n'as pas besoin d'ouvrir les classeurs pour copier leurs données. Colle la macro suivante dans le classeur "transit en forme.xls" :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub test()
    Dim Chemin As String, Fichier As String
    Dim Feuilles, Sh As String
    Feuilles = Array("ach", "aci", "acu", "bal", "jou")
    Feuilles2 = Array("achats", "aci", "acu", "bal", "jour")
    Chemin = "C:\mes documents\DEVBRUT\"
    Fichier = Dir(Chemin & "acu*.xlsm")
    Do While Fichier <> ""
        ThisWorkbook.Names.Add "Plage", _
            RefersTo:="='" & Chemin & "[" & Fichier & "]Sheet1'!$A$1:$M$275"
        Sh = Application.Index(Feuilles2, Application.Match(Left(Fichier, 3), Feuilles, 0))
        With Sheets(Sh)
            .Columns("A:A").Cut
            .Columns(15).Insert
            .[A1:M275] = "=Plage"
            .[A1:M275].Copy
            .[A1:M275].PasteSpecial xlPasteValues
            .Columns(14).Cut
            .Columns(1).Insert
        End With
        Fichier = Dir
    Loop
End Sub

Bonjour le Forum, bonjour Daniel,
comme promis je reviens avec les résultats des test en réel.

Tout d'abord ci-dessous le code élaboré par Daniel et modifié par moi avec les noms et adresses réels:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Sub brut_accachaciacu_vers_washed() Dim Chemin As String, Fichier As String Dim Feuilles, Sh As String Feuilles = Array("acc","ach", "aci", "acu") Feuilles2 = Array("ACC washed", "ACH washed", "ACI washed", "ACU washed") Chemin = "C:\DEV\DEV MENSUEL BRUT\" Fichier = Dir(Chemin & "acc*.xls") Do While Fichier <> "" ThisWorkbook.Names.Add "Plage", _ RefersTo:="='" & Chemin & "[" & Fichier & "]Sheet1'!$A$1:$N$2050" Sh = Application.Index(Feuilles2, Application.Match(Left(Fichier, 3), Feuilles, 0)) With Sheets(Sh) .Columns("A:A").Cut .Columns(15).Insert .[A1:N2050] = "=Plage" .[A1:N2050].Copy .[A1:N2050].PasteSpecial xlPasteValues .Columns(14).Cut .Columns(1).Insert End With Fichier = Dir Loop End Sub
J'ai une erreur d'exécution 1004, "la méthode PasteSpecial de la classe range a échoué". J'ai l'indication de cette erreur en faisant escape après que la macro reste bloquée. La ligne surlignée dans le code est [A1:N2050].PasteSpecial xlPasteValues.
Je précise que il n'y a pas de formule dans les zones que je voudrais copier. Il n'y a pas de formule non plus dans la zone où je voudrais coller.Je précise aisi que dans le classeur cible il y a d'autres fichiers que ceux visés. En regardant dans le forum j'ai vu qu'il fallait peut-être employer:
Code:

1 2 PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False
. J'ai fait l'essai mais j'obtiens la même erreur et la nouvelle ligne est surlignée comme fautive.
Merci beaucoup de me donner un coup de main.
Djepi

03/10/2011, 16h56
Daniel.C

Bonjour,

Citation:

Je précise que il n'y a pas de formule dans les zones que je voudrais copier

Oui, mais moi j'en mais une dans chaque cellule ;) Je n'arrive pas à voir pourquoi ça coince.
Je viens d'exécuter ces lignes ici et ça se passe bien quand aux autres paramètres de la méthode "Pastespecial", il sont optionels et ne servent pas en ce qui nous concernent.
Essaie :

Code:

[A1].PasteSpecial xlPasteValues

à la place, mais je n'y crois pas.
03/10/2011, 17h26
djepi

Bonjour le forum, bonjour Daniel,
merci pour ta réponse.
Non cela ne marche pas. Même message d'erreur et même ligne en erreur.
Est ce qu'une solution ne serait pas de d'abord ouvrir les fichiers via un code (je ne sais pas si c'est possible ?) et puis de faire les "copier-coller" ?
Je continue à chercher de mon coté. Si toi Daniel ou un autre membre du forum a la gentilesse de me donner des pistes je suis extrèmement preneur.
Mille mercis.
Djepi.

Je ne vais pas te retarder davantage. J'étais particulièrement fier de ma solution, pourtant. Oui, prend la solution s'il y en a eu une de postée, sinon, je travaille à en sortir une.

Essaie (non testé) en vérifiant les plages à copier et les noms de feuille :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 Sub brut_accachaciacu_vers_washed() Dim Chemin As String, Fichier As String Dim Feuilles, Sh As String Application.ScreenUpdating = False Feuilles = Array("acc", "ach", "aci", "acu") Feuilles2 = Array("ACC washed", "ACH washed", "ACI washed", "ACU washed") Chemin = "C:\DEV\DEV MENSUEL BRUT\" Fichier = Dir(Chemin & "acc*.xls") Do While Fichier <> "" Workbooks.Open Chemin & Fichier Sh = Application.Index(Feuilles2, Application.Match(Left(Fichier, 3), Feuilles, 0)) Sheets("Sheet1").[B1:O2050].Copy With ThisWorkbook.Sheets(Sh) .[B1:O2050].PasteSpecial xlPasteValues End With ActiveWorkbook.Close False Fichier = Dir Loop Application.ScreenUpdating = True End Sub
Une précision; en relisant les différents messages, on ne peut pas faire de sélection sur les noms des fichiers. Il faut donc écrire :

Code:

Fichier = Dir(Chemin & "*.xls")

au lieu de :

Code:

Fichier = Dir(Chemin & "acc*.xls")

04/10/2011, 11h44
djepi
Bonjour le Forum, bonjour Daniel
Daniel tu peux être fier parce que le dernier code que tu m'as fourni marche (presque) parfaitement bien. Je te donne le feedback complet:
1)j'ai vérifié et modifié range qd nécessaire (B1:O2050) devient (A1:N2050)
2)j'ai lancé test et j'ai eu 4 messages ms "presse papier contient gde qté info...". Après recherche sur le forum j'ai pu éliminer ces messages en incorporant
Code:

1 2 Application.DisplayAlerts=False Application.DisplayAlerts=True
3)la macro copie et colle parfaitement les 4 fichiers demandés mais se termine sur une erreur d'exécution 13 incompatibilité de type sur la ligne

Code:

Sh = Application.Index(Feuilles2, Application.Match(Left(Fichier, 3), Feuilles, 0))

4)lorsque je sors de la macro je me retrouve dans le fichier "balance0711.xls" qui est un des fichiers .xls contenu dans "DEV MENSUEL BRUT" et qui est le fichier qui, alphabétiquement, suit le dernier fichier .xls copié, à savoir "acu*.xls.
Mes réflexions:
1)est ce que l'incompatibilité de type ne viendrait pas du fait qu'il teste un fichier "bal*.xls" qui est différent de ce qui est défini dans les Feuilles?
2)dans les fichiers .xls qui se trouvent dans "DEV MENSUEL BRUT" il y en a encore 2 que je dois copier/coller. Mais les critères ne sont pas les mêmes que pour les 4 autres fichiers.
a)pour le fichier "bal*.xls": il faut copier A1:I2050 de sheet1 et coller en U1 de l'onglet "BAL washed" de l'activeworkbook et b)pour le fichier "TVA*.xls il faut copier A1:O250 du dernier onglet existant et coller en A1 de l'onglet "TVA washed" de l'activeworkbook. Penses tu qu'il est imaginable d'inclure ces deux actions supplémentaires dans la même procédure?
Je suis extrèmement reconnaissant de l'aide que je recois Daniel, et, si de mon coté je peux aider dans des recherches, tests et explications complémentaires je serai plus qu'heureux de le faire.
Merci.
Djepi
04/10/2011, 12h10
Daniel.C

Bonjour,

Citation:

1)est ce que l'incompatibilité de type ne viendrait pas du fait qu'il teste un fichier "bal*.xls" qui est différent de ce qui est défini dans les Feuilles?

Non, ça vient du fait que je n'avais pas mis les tests sur les nom de fichiers. :oops:
En ce qui concerne les 2 fichiers supplémentaires,

Citation:

a)pour le fichier "bal*.xls"

Il y en a déjà un qui a le même début de nom dans les5 fichiers déjà traités. Peux-tu préciser ?

Merci beaucoup pour ton message. Voici mes réponses.
Tout d'abord pour éviter toute confusion je remets ci-dessous le dernier code employé pour mes test
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Sub brut_accachaciacu_vers_washed() Dim Chemin As String, Fichier As String Dim Feuilles, Sh As String Application.ScreenUpdating = False Application.DisplayAlerts = False Feuilles = Array("acc", "ach", "aci", "acu") Feuilles2 = Array("ACC washed", "ACH washed", "ACI washed", "ACU washed") Chemin = "C:\DEV\DEV MENSUEL BRUT\" Fichier = Dir(Chemin & "*.xls") Do While Fichier <> "" Workbooks.Open Chemin & Fichier Sh = Application.Index(Feuilles2, Application.Match(Left(Fichier, 3), Feuilles, 0)) Sheets("Sheet1").[A1:N2050].Copy With ThisWorkbook.Sheets(Sh) .[A1:N2050].PasteSpecial xlPasteValues End With ActiveWorkbook.Close False Fichier = Dir Loop Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub
Citation:

Non, ça vient du fait que je n'avais pas mis les tests sur les nom de fichiers. :oops:

peux-tu me préciser ce que je dois changer stp.?

Citation:

En ce qui concerne les 2 fichiers supplémentaires,
Il y en a déjà un qui a le même début de nom dans les5 fichiers déjà traités. Peux-tu préciser ?

Je ne pense pas qu'il y ait un double emploi Daniel.
Pour le moment la macro traite 4 fichiers (acc*.xls; ach*.xls; aci*.xls; acu*.xls) et dans ces 4 fichiers la feuille est toujours la même (sheet1) et le range est toujours le même (A1:N2050).

Les deux fichiers supplémentaires ne répondent pas aux mêmes critères.
a)le fichier "bal*.xls" qui se trouve dans "DEV MENSUEL BRUT" et dont je voudrais copier de la feuille "sheet1" le range (A1:I2050) pour aller le coller en (U1:AC2050) de l'onglet nommé "BAL washed" de l'activeworkbook et

b)le fichier "TVA*.xls" qui se trouve dans "DEV MENSUEL BRUT" et dont je voudrais copier de la dernière feuille (en employant sheets.count peut-etre :?)
le range (A1:O250) pour aller le coller en (A1:O250) de l'onglet nommé "VAT washed" de l'activeworkbook.

Voilà Daniel, j'espère avoir été clair. Merci pour ton attention et ton aide.

Djepi.

J'ai apporté toutes les modifications, donc le code devrait être exécutable tel quel. Vérifie simplement les majuscules et minuscules dans les noms de fichier.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub brut_accachaciacu_vers_washed()
    Dim Chemin As String, Fichier As String
    Dim Feuilles, Sh As String
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Feuilles = Array("acc", "ach", "aci", "acu")
    Feuilles2 = Array("ACC washed", "ACH washed", "ACI washed", "ACU washed")
    Chemin = "C:\DEV\DEV MENSUEL BRUT\"
    Fichier = Dir(Chemin & "*.xls")
    Do While Fichier <> ""
        If Left(Fichier, 7) = "achats " Or Left(Fichier, 4) = "aci " Or Left(Fichier, 4) = "acu " Or _
            Left(Fichier, 5) = "jour " Then
            Workbooks.Open Chemin & Fichier
            Sh = Application.Index(Feuilles2, Application.Match(Left(Fichier, 3), Feuilles, 0))
            Sheets("Sheet1").[A1:N2050].Copy
            With ThisWorkbook.Sheets(Sh)
                .[B1:O2050].PasteSpecial xlPasteValues
            End With
            ActiveWorkbook.Close False
        ElseIf Left(Fichier, 3) = "bal" Then
            Sheets("Sheet1").[A1:I2050].Copy
            With ThisWorkbook.Sheets("BAL washed")
                .[U1:AC2050].PasteSpecial xlPasteValues
            End With
        ElseIf Left(Fichier, 3) = "TVA" Then
            Sheets(Sheets.Count).[A1:O250].Copy
            With ThisWorkbook.Sheets("VAT washed")
                .[A1:O250].PasteSpecial xlPasteValues
            End With
        End If
        Fichier = Dir
    Loop
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

04/10/2011, 23h33
djepi
Bonsoir le Forum, bonsoir Daniel,
de retour comme promis.

J'ai testé et j'ai eu deux petits soucis.
Un ici
Code:

1 2 ElseIf Left(Fichier, 3) = "bal" Then Sheets("Sheet1").[A1:I2050].Copy
et un ici
Code:

1 2 ElseIf Left(Fichier, 3) = "TVA" Then Sheets(Sheets.Count).[A1:O250].Copy
où la macro ne trouvait pas le nom. De facon tout a fait empirique, en observant ton code, j'ai rajouté deux fois une ligne, c'est devenu
Code:

1 2 3 ElseIf Left(Fichier, 3) = "bal" Then Workbooks.Open Chemin & Fichier Sheets("Sheet1").[A1:I2050].Copy
et
Code:

1 2 3 ElseIf Left(Fichier, 3) = "TVA" Then Workbooks.Open Chemin & Fichier Sheets(Sheets.Count).[A1:O250].Copy
Ta macro marche superbement et je t'en remercie.

Un dernier point dont je veux te parler: la macro se termine dans le dernier onglet du fichier "TVA*.xls (qui est dans DEV MENSUEL BRUT).Il faut fermer ce fichier manuellement et ms excel dit "Presse papier contient grande qté....", réponse non, le fichier se ferme et on se retrouve dans la page "TVA washed" de l'activeworkbook.
AMENDEMENT: je viens de voir également que le fichier "bal*.xls" reste lui aussi ouvert.Donc le souci de refermeture des fichier se produit pour les deux derniers fichiers traités.
Idéalement je voudrais terminer en cellule A1 d'un onglet nommé "PILOTAGE" dans l'activeworkbook.
J'ai essayé d'inclure une ligne

Code:

Thisworkbook.Sheets("PILOTAGE").[A1:A1].Select

après le loop mais la macro bloque sur l'instruction Select.
Aurais-tu la gentilesse de me donner encore un coup de main pour trouver la bonne instruction?
Encore un énorme merci pour cette application.
Cordialement
Djepi

Essaie la macro :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Sub brut_accachaciacu_vers_washed()
    Dim Chemin As String, Fichier As String
    Dim Feuilles, Sh As String
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Feuilles = Array("acc", "ach", "aci", "acu")
    Feuilles2 = Array("ACC washed", "ACH washed", "ACI washed", "ACU washed")
    Chemin = "C:\DEV\DEV MENSUEL BRUT\"
    Fichier = Dir(Chemin & "*.xls")
    Do While Fichier <> ""
        If Left(Fichier, 7) = "achats " Or Left(Fichier, 4) = "aci " Or Left(Fichier, 4) = "acu " Or _
            Left(Fichier, 5) = "jour " Then
            Workbooks.Open Chemin & Fichier
            Sh = Application.Index(Feuilles2, Application.Match(Left(Fichier, 3), Feuilles, 0))
            Sheets("Sheet1").[A1:N2050].Copy
            With ThisWorkbook.Sheets(Sh)
                .[B1:O2050].PasteSpecial xlPasteValues
            End With
            ActiveWorkbook.Close False
        ElseIf Left(Fichier, 3) = "bal" Then
            Workbooks.Open Chemin & Fichier
            Sheets("Sheet1").[A1:I2050].Copy
            With ThisWorkbook.Sheets("BAL washed")
                .[U1:AC2050].PasteSpecial xlPasteValues
            End With
            ActiveWorkbook.Close False
        ElseIf Left(Fichier, 3) = "TVA" Then
            Workbooks.Open Chemin & Fichier
            Sheets(Sheets.Count).[A1:O250].Copy
            With ThisWorkbook.Sheets("VAT washed")
                .[A1:O250].PasteSpecial xlPasteValues
            End With
            ActiveWorkbook.Close False
        End If
        Fichier = Dir
    Loop
    ThisWorkbook.Activate
    ThisWorkbook.Sheets("PILOTAGE").Select
    [A1].Select
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

05/10/2011, 22h58
djepi

Bonsoir le Forum, bonsoir Daniel,
Daniel, tout fonctionne parfaitement!
Un tout grand merci pour ton aide et respect pour ton professionnalisme, tes connaisances et ta patience vis à vis d'un "totalement non expert".
A bientôt sur le forum.
Bien à toi.
Djepi

Fuseau horaire GMT +2. Il est actuellement 08h01.