sélection partie de nom de fichier [Résolu]

[djepi]

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.

[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

[Daniel.C]

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

[Theze]

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é.

[djepi]

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

[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é.

[djepi]

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

[Daniel.C]

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

[djepi]

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

[Daniel.C]

Bonjour,

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.

[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.

[Daniel.C]

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")

[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

[Daniel.C]

Bonjour,

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.
En ce qui concerne les 2 fichiers supplémentaires,

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 ?

[djepi]

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

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

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

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.

[Daniel.C]

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

[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

[Daniel.C]

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

[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