ouvrir le fichier suivant

[simonbaron]

Bonjour,

Petit problème. Ma macro doit ouvrir dans le même classeur plusieurs fichiers, et copier certaines cellules afin de les coller dans un fichier global ("global.xls"). Comment je peux lui dire "Si tu ne trouve pas ce fichier, dans "global.xls" descend de X lignes et passe au fichier suivant". Je vous joins une partie de ma macro:

Workbooks.Open ("V:\....\CHINA.xls")
Range("IV3").End(xlToLeft).Select
Range(Selection, Selection.Offset(12, -2)).Select
Selection.Copy
Windows("global.xls").Activate
ActiveSheet.Paste
ActiveCell.Offset(13, 0).Range("A1").Select
Windows(“CHINA.xls").Activate
ActiveWindow.Close

Workbooks.Open ("V:\...\ CROATIA.xls")
Range("IV3").End(xlToLeft).Select
Range(Selection, Selection.Offset(12, -2)).Select
Selection.Copy
Windows("global.xls").Activate
ActiveSheet.Paste
ActiveCell.Offset(13, 0).Range("A1").Select
Windows(“CROATIA.xls").Activate
ActiveWindow.Close

Dans ce cas là, je voudrais lui dire: "Si le fichier "CHINA" n'existe pas, dans le fichier "global" descend de 13 lignes et passe au fichier "CROATIA". Mais comme il y aura 30 fichiers, est-ce qu'il est possible de lui donner une comande plus générique (genre "si CE fichier n'existe pas, ....., ouvre le fichier qui vient après dans la liste").

Merci beaucoup

 

[Vorens]

Re : ouvrir le fichier suivant

Bonjour,


La fonction DIR peut t'aider, elle sert à vérifier l'existance d'un fichier.

CheminFichier = V:\...\ CROATIA.xls (C'est un exemple)

If Dir(CheminFichier) <> "" Then

...
...
...

else

...
...
...
end if


(si CheminFichier est différent de rien) si oui c'est que ton fichier existe donc, importation. si non c'est qu'il existe pas, rechercher le fichier suivant).

Cordialement

 

[Softmama]

Re : ouvrir le fichier suivant

bonjour,

ceci à tester :

sub mouarf()
dim c as range
Fichiers = array("CROATIA.XLS", "CHINA.XLS", "MARS.XLS"...) 'Placer les noms des fichiers
set c= Range("A2") ' 1ère cellule où viennent se coller les exports
for t= lbound(Fichiers) to ubound(fichiers)
if dir("V:\...\" & Fichiers(t)) <>"" then 
   workbooks(fichiers(t)).open  range(Range("IV3").End(xlToLeft),Range("IV3").End(xlToLeft).offset(12,-2)).copy c
   workbooks(fichiers(t)).close 
end if
set c=c(14,1)
next t
end sub

 

[Robert]

Re : ouvrir le fichier suivant

Bonjour Simonbaron et bienvenu, Vorens, bonjour le forum,

Une proposition mas je vient de voir que Softmama m'a grillé avec un code similaire au mien... Le sien est mieux mais comme j'ai commenté le mien je te le donne quand même. Comme je ne savais pas comment alimenter le tableau de variables tbc car je manquais d'élément, je suis parti du code sans cette partie...

Sub Macro1()
Dim tbc(29) As String 'déclare le tableau de variables tbc (TaBleau des Classeurs)
Dim cb As Range 'déclare la variable cb (Cellule de Base)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)
 
'manque la partie d'alimentation du tableau tbc...
 
Set dest = Workbooks("global.xls").Sheets(1).Range("A1") 'définit la cellule de destination
For x = 0 To UBound(tbf) 'boucle sur tous les classseur à ouvrir
    On Error Resume Next 'gestion des erreur, en cas d'erreur passe à la ligne suivante
    Workbooks.Open (tbf(x))
    If Err > 0 Then 'condition : si une érreur a été générée
        Err = 0 'annulle l'erreur
        GoTo suite 'va à l'étiquette suite
    End If 'fin de la condition
    Set cb = Range("IV3").End(xlToLeft) 'définit la cellule de base
    Range(cb, cb.Offset(12, -2)).Copy dest 'copie la plage par rapport à la cellule de base dans la cellule de destination
    Workbooks("CHINA.xls").Close 'ferme le classeur
suite: 'étiquette
    Set dest = dest.Offset(13, 0) 'redéfinit la cellule de destination
Next x
End Sub

 

[simonbaron]

Re : ouvrir le fichier suivant

Merci à tous pour votre rapidité! du coup j'ai essayé le code de Softmama mais il me dit qu'il y a une erreur de syntaxe à la ligne

workbooks(fichiers(t)).open range(Range("IV3").End(xlToLeft),Range("IV3").End(xlToLeft).offset(12,-2)).copy c

Vous voyez quelque chose qui cloche?
Question: la macro que tu as écrite va remplacer la totalité de ma macro? c'est à dire que je n'ai plus besoin d'avoir un "bloc" par fichier?

Merci encore

 

[Softmama]

Re : ouvrir le fichier suivant

re,

il doit manquer le chemin, remplace la ligne

workbooks(fichiers(t)).open

par :

workbooks("V:\...\" & fichiers(t)).open

en mettant le bon chemin.

Et oui, ce code devrait de permettre de remplacer l'ensemble de tes blocs.

 

[simonbaron]

Re : ouvrir le fichier suivant

Pas encore, maintenant il me dit qu'il y a une erreur de compilation dans la même ligne... peut être c'est la "c" après Copy qui pose problème? voilà comment j'avais modifié

Dim c As Range
fichiers = Array("CHINA.XLS", "CROATIA.XLS", "UK.XLS")
Set c = Range("A1")
For t = LBound(fichiers) To UBound(fichiers)
If Dir("V:\DSFS\SEG\OPE\03_KRI\2011\T2\ALD\" & fichiers(t)) <> "" Then
Workbooks("V:\DSFS\SEG\OPE\03_KRI\2011\T2\ALD\" & fichiers(t)).Open Range(Range("IV3").End(xlToLeft), Range("IV3").End(xlToLeft).Offset(12, -2)).Copy c
Workbooks("V:\DSFS\SEG\OPE\03_KRI\2011\T2\ALD\" & fichiers(t)).Close
End If
Set c = c(14, 1)
Next t

 

[Softmama]

Re : ouvrir le fichier suivant

re,

oui, j'ai fait n'importe quoi là, la bonne syntaxe est :

Dim c As Range, chemin as string
chemin = "V:\DSFS\SEG\OPE\03_KRI\2011\T2\ALD\"
fichiers = Array("China.xls", "Croatia.xls", "UK.xls")
Set c = Range("A1")
For t = LBound(fichiers) To UBound(fichiers)
If Dir(chemin & fichiers(t)) <> "" Then
  Workbooks.Open chemin & fichiers(t)
Range(Range("IV3").End(xlToLeft), Range("IV3").End(xlToLeft).Offset(12, -2)).Copy c
Workbooks(fichiers(t)).Close
End If
Set c = c(14, 1)
Next t

 

[simonbaron]

Re : ouvrir le fichier suivant

Merci beaucoup, ça marche!
Juste quelques modifs:
- je voudrais mettre un collage spécial pour coller seulement les valeurs (il y a des formules dans les tableaux), où je peux ajouter une ligne genre

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

- on me demande à chaque fois si je veux enregistrer les modifs aux fichiers, mais c'est inutile, comment enlever ce message?
- les fichiers seront ouverts dans l'ordre avec lequel je les écris en ligne 3?

Merci beaucoup

 

[Softmama]

Re : ouvrir le fichier suivant

Re,

modifie la macro ainsi :

Dim c As Range, chemin as string
chemin = "V:\DSFS\SEG\OPE\03_KRI\2011\T2\ALD\"
fichiers = Array("China.xls", "Croatia.xls", "UK.xls")
Set c = Range("A1")
For t = LBound(fichiers) To UBound(fichiers)
If Dir(chemin & fichiers(t)) <> "" Then
  Workbooks.Open chemin & fichiers(t)
Range(Range("IV3").End(xlToLeft), Range("IV3").End(xlToLeft).Offset(12, -2)).Copy
c.pastespecial Paste:=xlpasteValues
Workbooks(fichiers(t)).Close false
End If
Set c = c(14, 1)
Next t

et oui, ils sont copiés dans l'ordre trouvé dans le Array(...)

 

[simonbaron]

Re : ouvrir le fichier suivant

Absolument parfait!

merci beaucoup, j'espère pouvoir compter encore sur ton aide prochainement