J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs situés
dans le répertoire Truc, de façon à remplir un tableau "récap" dans le
classeur actif, puis de les refermer sans enregistrer.
Je souhaiterais que la procédure fonctionne également si certains classeurs
sont déjà ouverts, et dans ce cas les laisser ouverts après copie des
données, et les autres classeurs qui étaient fermés, les refermer après coup.
Merci d'avance,
Ggal
Sub Test()
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "\Truc\"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
Workbooks.Open f1
With Workbooks(wb).Sheets("feuil1")
.Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
.Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
Workbooks(f1.Name).Close False
Next
End Sub
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Jacques ALARDET
Bonjour GGAL
Plusieurs solutions :
La plus simple peut être est de faire, avant chaque ouverture : On Error goto E1 Workbook(Nom du classeur).activate On error goto 0: goto S2 'En séquence cela signifie que le classeur est déjà ouvert : mais attention il faut vérifier que le Path est identique S1: 'Ici tu ouvres le classeur S2:
E1: resume S1 'Le classeur n'est pas ouvert
J a c q u e s
"GGAL" a écrit dans le message de news:
Bonjour,
J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs situés dans le répertoire Truc, de façon à remplir un tableau "récap" dans le classeur actif, puis de les refermer sans enregistrer. Je souhaiterais que la procédure fonctionne également si certains classeurs sont déjà ouverts, et dans ce cas les laisser ouverts après copie des données, et les autres classeurs qui étaient fermés, les refermer après coup.
Merci d'avance,
Ggal
Sub Test() wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc Workbooks.Open f1 With Workbooks(wb).Sheets("feuil1") .Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") .Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 Workbooks(f1.Name).Close False Next End Sub
Bonjour GGAL
Plusieurs solutions :
La plus simple peut être est de faire, avant chaque ouverture :
On Error goto E1
Workbook(Nom du classeur).activate
On error goto 0: goto S2
'En séquence cela signifie que le classeur est déjà ouvert : mais attention
il faut vérifier que le Path est identique
S1:
'Ici tu ouvres le classeur
S2:
E1: resume S1 'Le classeur n'est pas ouvert
J a c q u e s
"GGAL" <GGAL@discussions.microsoft.com> a écrit dans le message de
news:142A62C3-7736-40B6-827F-E3AF940D6C83@microsoft.com...
Bonjour,
J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs
situés
dans le répertoire Truc, de façon à remplir un tableau "récap" dans le
classeur actif, puis de les refermer sans enregistrer.
Je souhaiterais que la procédure fonctionne également si certains
classeurs
sont déjà ouverts, et dans ce cas les laisser ouverts après copie des
données, et les autres classeurs qui étaient fermés, les refermer après
coup.
Merci d'avance,
Ggal
Sub Test()
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
Workbooks.Open f1
With Workbooks(wb).Sheets("feuil1")
.Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
.Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
Workbooks(f1.Name).Close False
Next
End Sub
La plus simple peut être est de faire, avant chaque ouverture : On Error goto E1 Workbook(Nom du classeur).activate On error goto 0: goto S2 'En séquence cela signifie que le classeur est déjà ouvert : mais attention il faut vérifier que le Path est identique S1: 'Ici tu ouvres le classeur S2:
E1: resume S1 'Le classeur n'est pas ouvert
J a c q u e s
"GGAL" a écrit dans le message de news:
Bonjour,
J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs situés dans le répertoire Truc, de façon à remplir un tableau "récap" dans le classeur actif, puis de les refermer sans enregistrer. Je souhaiterais que la procédure fonctionne également si certains classeurs sont déjà ouverts, et dans ce cas les laisser ouverts après copie des données, et les autres classeurs qui étaient fermés, les refermer après coup.
Merci d'avance,
Ggal
Sub Test() wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc Workbooks.Open f1 With Workbooks(wb).Sheets("feuil1") .Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") .Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 Workbooks(f1.Name).Close False Next End Sub
GGAL
Merci de la réponse, mais je ne vois pas très bien où placer ces étiquettes dans mon cas. GGal
Bonjour GGAL
Plusieurs solutions :
La plus simple peut être est de faire, avant chaque ouverture : On Error goto E1 Workbook(Nom du classeur).activate On error goto 0: goto S2 'En séquence cela signifie que le classeur est déjà ouvert : mais attention il faut vérifier que le Path est identique S1: 'Ici tu ouvres le classeur S2:
E1: resume S1 'Le classeur n'est pas ouvert
J a c q u e s
"GGAL" a écrit dans le message de news:
Bonjour,
J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs situés dans le répertoire Truc, de façon à remplir un tableau "récap" dans le classeur actif, puis de les refermer sans enregistrer. Je souhaiterais que la procédure fonctionne également si certains classeurs sont déjà ouverts, et dans ce cas les laisser ouverts après copie des données, et les autres classeurs qui étaient fermés, les refermer après coup.
Merci d'avance,
Ggal
Sub Test() wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc Workbooks.Open f1 With Workbooks(wb).Sheets("feuil1") .Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") .Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 Workbooks(f1.Name).Close False Next End Sub
Merci de la réponse, mais je ne vois pas très bien où placer ces étiquettes
dans mon cas.
GGal
Bonjour GGAL
Plusieurs solutions :
La plus simple peut être est de faire, avant chaque ouverture :
On Error goto E1
Workbook(Nom du classeur).activate
On error goto 0: goto S2
'En séquence cela signifie que le classeur est déjà ouvert : mais attention
il faut vérifier que le Path est identique
S1:
'Ici tu ouvres le classeur
S2:
E1: resume S1 'Le classeur n'est pas ouvert
J a c q u e s
"GGAL" <GGAL@discussions.microsoft.com> a écrit dans le message de
news:142A62C3-7736-40B6-827F-E3AF940D6C83@microsoft.com...
Bonjour,
J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs
situés
dans le répertoire Truc, de façon à remplir un tableau "récap" dans le
classeur actif, puis de les refermer sans enregistrer.
Je souhaiterais que la procédure fonctionne également si certains
classeurs
sont déjà ouverts, et dans ce cas les laisser ouverts après copie des
données, et les autres classeurs qui étaient fermés, les refermer après
coup.
Merci d'avance,
Ggal
Sub Test()
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
Workbooks.Open f1
With Workbooks(wb).Sheets("feuil1")
.Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
.Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
Workbooks(f1.Name).Close False
Next
End Sub
Merci de la réponse, mais je ne vois pas très bien où placer ces étiquettes dans mon cas. GGal
Bonjour GGAL
Plusieurs solutions :
La plus simple peut être est de faire, avant chaque ouverture : On Error goto E1 Workbook(Nom du classeur).activate On error goto 0: goto S2 'En séquence cela signifie que le classeur est déjà ouvert : mais attention il faut vérifier que le Path est identique S1: 'Ici tu ouvres le classeur S2:
E1: resume S1 'Le classeur n'est pas ouvert
J a c q u e s
"GGAL" a écrit dans le message de news:
Bonjour,
J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs situés dans le répertoire Truc, de façon à remplir un tableau "récap" dans le classeur actif, puis de les refermer sans enregistrer. Je souhaiterais que la procédure fonctionne également si certains classeurs sont déjà ouverts, et dans ce cas les laisser ouverts après copie des données, et les autres classeurs qui étaient fermés, les refermer après coup.
Merci d'avance,
Ggal
Sub Test() wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc Workbooks.Open f1 With Workbooks(wb).Sheets("feuil1") .Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") .Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 Workbooks(f1.Name).Close False Next End Sub
Frédéric Sigonneau
Pas vraiment testé, juste pour l'idée :
'========================= Sub Test() Dim Wbk As Workbook, DejaOuvert As Boolean wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc On Error Resume Next Set Wbk = Workbooks(f1.Name) If Err <> 0 Then Workbooks.Open f1 Else DejaOuvert = True End If On Error GoTo 0 Workbooks.Open f1 With Workbooks(wb).Sheets("feuil1") .Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") .Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 If Not DejaOuvert Then Workbooks(f1.Name).Close False Next End Sub '========================== FS --- Frédéric Sigonneau http://frederic.sigonneau.free.fr
Bonjour,
J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs situés dans le répertoire Truc, de façon à remplir un tableau "récap" dans le classeur actif, puis de les refermer sans enregistrer. Je souhaiterais que la procédure fonctionne également si certains classeurs sont déjà ouverts, et dans ce cas les laisser ouverts après copie des données, et les autres classeurs qui étaient fermés, les refermer après coup.
Merci d'avance,
Ggal
Sub Test() wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc Workbooks.Open f1 With Workbooks(wb).Sheets("feuil1") ..Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") ..Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 Workbooks(f1.Name).Close False Next End Sub
Pas vraiment testé, juste pour l'idée :
'========================= Sub Test()
Dim Wbk As Workbook, DejaOuvert As Boolean
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
On Error Resume Next
Set Wbk = Workbooks(f1.Name)
If Err <> 0 Then
Workbooks.Open f1
Else
DejaOuvert = True
End If
On Error GoTo 0
Workbooks.Open f1
With Workbooks(wb).Sheets("feuil1")
.Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
.Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
If Not DejaOuvert Then Workbooks(f1.Name).Close False
Next
End Sub
'==========================
FS
---
Frédéric Sigonneau
http://frederic.sigonneau.free.fr
Bonjour,
J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs situés
dans le répertoire Truc, de façon à remplir un tableau "récap" dans le
classeur actif, puis de les refermer sans enregistrer.
Je souhaiterais que la procédure fonctionne également si certains classeurs
sont déjà ouverts, et dans ce cas les laisser ouverts après copie des
données, et les autres classeurs qui étaient fermés, les refermer après coup.
Merci d'avance,
Ggal
Sub Test()
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
Workbooks.Open f1
With Workbooks(wb).Sheets("feuil1")
..Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
..Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
Workbooks(f1.Name).Close False
Next
End Sub
'========================= Sub Test() Dim Wbk As Workbook, DejaOuvert As Boolean wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc On Error Resume Next Set Wbk = Workbooks(f1.Name) If Err <> 0 Then Workbooks.Open f1 Else DejaOuvert = True End If On Error GoTo 0 Workbooks.Open f1 With Workbooks(wb).Sheets("feuil1") .Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") .Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 If Not DejaOuvert Then Workbooks(f1.Name).Close False Next End Sub '========================== FS --- Frédéric Sigonneau http://frederic.sigonneau.free.fr
Bonjour,
J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs situés dans le répertoire Truc, de façon à remplir un tableau "récap" dans le classeur actif, puis de les refermer sans enregistrer. Je souhaiterais que la procédure fonctionne également si certains classeurs sont déjà ouverts, et dans ce cas les laisser ouverts après copie des données, et les autres classeurs qui étaient fermés, les refermer après coup.
Merci d'avance,
Ggal
Sub Test() wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc Workbooks.Open f1 With Workbooks(wb).Sheets("feuil1") ..Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") ..Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 Workbooks(f1.Name).Close False Next End Sub
GGAL
Non ça ne marche pas. On me propose de rouvrir le fichier alors qu'il était fermé. Et quand il est ouvert, même message. Ggal
Pas vraiment testé, juste pour l'idée :
'========================= > Sub Test() Dim Wbk As Workbook, DejaOuvert As Boolean wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc On Error Resume Next Set Wbk = Workbooks(f1.Name) If Err <> 0 Then Workbooks.Open f1 Else DejaOuvert = True End If On Error GoTo 0 Workbooks.Open f1 With Workbooks(wb).Sheets("feuil1") .Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") .Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 If Not DejaOuvert Then Workbooks(f1.Name).Close False Next End Sub '========================== > FS --- Frédéric Sigonneau http://frederic.sigonneau.free.fr
Bonjour,
J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs situés dans le répertoire Truc, de façon à remplir un tableau "récap" dans le classeur actif, puis de les refermer sans enregistrer. Je souhaiterais que la procédure fonctionne également si certains classeurs sont déjà ouverts, et dans ce cas les laisser ouverts après copie des données, et les autres classeurs qui étaient fermés, les refermer après coup.
Merci d'avance,
Ggal
Sub Test() wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc Workbooks.Open f1 With Workbooks(wb).Sheets("feuil1") ..Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") ..Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 Workbooks(f1.Name).Close False Next End Sub
Non ça ne marche pas.
On me propose de rouvrir le fichier alors qu'il était fermé. Et quand il est
ouvert, même message.
Ggal
Pas vraiment testé, juste pour l'idée :
'========================= > Sub Test()
Dim Wbk As Workbook, DejaOuvert As Boolean
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
On Error Resume Next
Set Wbk = Workbooks(f1.Name)
If Err <> 0 Then
Workbooks.Open f1
Else
DejaOuvert = True
End If
On Error GoTo 0
Workbooks.Open f1
With Workbooks(wb).Sheets("feuil1")
.Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
.Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
If Not DejaOuvert Then Workbooks(f1.Name).Close False
Next
End Sub
'========================== >
FS
---
Frédéric Sigonneau
http://frederic.sigonneau.free.fr
Bonjour,
J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs situés
dans le répertoire Truc, de façon à remplir un tableau "récap" dans le
classeur actif, puis de les refermer sans enregistrer.
Je souhaiterais que la procédure fonctionne également si certains classeurs
sont déjà ouverts, et dans ce cas les laisser ouverts après copie des
données, et les autres classeurs qui étaient fermés, les refermer après coup.
Merci d'avance,
Ggal
Sub Test()
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
Workbooks.Open f1
With Workbooks(wb).Sheets("feuil1")
..Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
..Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
Workbooks(f1.Name).Close False
Next
End Sub
Non ça ne marche pas. On me propose de rouvrir le fichier alors qu'il était fermé. Et quand il est ouvert, même message. Ggal
Pas vraiment testé, juste pour l'idée :
'========================= > Sub Test() Dim Wbk As Workbook, DejaOuvert As Boolean wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc On Error Resume Next Set Wbk = Workbooks(f1.Name) If Err <> 0 Then Workbooks.Open f1 Else DejaOuvert = True End If On Error GoTo 0 Workbooks.Open f1 With Workbooks(wb).Sheets("feuil1") .Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") .Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 If Not DejaOuvert Then Workbooks(f1.Name).Close False Next End Sub '========================== > FS --- Frédéric Sigonneau http://frederic.sigonneau.free.fr
Bonjour,
J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs situés dans le répertoire Truc, de façon à remplir un tableau "récap" dans le classeur actif, puis de les refermer sans enregistrer. Je souhaiterais que la procédure fonctionne également si certains classeurs sont déjà ouverts, et dans ce cas les laisser ouverts après copie des données, et les autres classeurs qui étaient fermés, les refermer après coup.
Merci d'avance,
Ggal
Sub Test() wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc Workbooks.Open f1 With Workbooks(wb).Sheets("feuil1") ..Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") ..Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 Workbooks(f1.Name).Close False Next End Sub
Frédéric Sigonneau
Comme je l'avais dit, peu testé. J'avais oublié de désactivé l'instruction initiale d'ouverture des classeurs. Ça devrait aller mieux comme ça :
'========================= Sub Test() Dim Wbk As Workbook, DejaOuvert As Boolean wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc On Error Resume Next Set Wbk = Workbooks(f1.Name) If Err <> 0 Then Workbooks.Open f1 Else DejaOuvert = True End If On Error GoTo 0 ' Workbooks.Open f1 '<<<<<<<<< bis repetita non placent With Workbooks(wb).Sheets("feuil1") .Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") .Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 If Not DejaOuvert Then Workbooks(f1.Name).Close False Next End Sub '========================== FS --- Frédéric Sigonneau http://frederic.sigonneau.free.fr
Non ça ne marche pas. On me propose de rouvrir le fichier alors qu'il était fermé. Et quand il est ouvert, même message. Ggal
Pas vraiment testé, juste pour l'idée :
'========================= >> Sub Test() Dim Wbk As Workbook, DejaOuvert As Boolean wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc On Error Resume Next Set Wbk = Workbooks(f1.Name) If Err <> 0 Then Workbooks.Open f1 Else DejaOuvert = True End If On Error GoTo 0 Workbooks.Open f1 With Workbooks(wb).Sheets("feuil1") .Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") .Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 If Not DejaOuvert Then Workbooks(f1.Name).Close False Next End Sub '========================== >> FS --- Frédéric Sigonneau http://frederic.sigonneau.free.fr
Bonjour,
J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs situés dans le répertoire Truc, de façon à remplir un tableau "récap" dans le classeur actif, puis de les refermer sans enregistrer. Je souhaiterais que la procédure fonctionne également si certains classeurs sont déjà ouverts, et dans ce cas les laisser ouverts après copie des données, et les autres classeurs qui étaient fermés, les refermer après coup.
Merci d'avance,
Ggal
Sub Test() wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc Workbooks.Open f1 With Workbooks(wb).Sheets("feuil1") ..Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") ..Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 Workbooks(f1.Name).Close False Next End Sub
Comme je l'avais dit, peu testé. J'avais oublié de désactivé l'instruction
initiale d'ouverture des classeurs. Ça devrait aller mieux comme ça :
'========================= Sub Test()
Dim Wbk As Workbook, DejaOuvert As Boolean
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
On Error Resume Next
Set Wbk = Workbooks(f1.Name)
If Err <> 0 Then
Workbooks.Open f1
Else
DejaOuvert = True
End If
On Error GoTo 0
' Workbooks.Open f1 '<<<<<<<<< bis repetita non placent
With Workbooks(wb).Sheets("feuil1")
.Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
.Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
If Not DejaOuvert Then Workbooks(f1.Name).Close False
Next
End Sub
'==========================
FS
---
Frédéric Sigonneau
http://frederic.sigonneau.free.fr
Non ça ne marche pas.
On me propose de rouvrir le fichier alors qu'il était fermé. Et quand il est
ouvert, même message.
Ggal
Pas vraiment testé, juste pour l'idée :
'========================= >> Sub Test()
Dim Wbk As Workbook, DejaOuvert As Boolean
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
On Error Resume Next
Set Wbk = Workbooks(f1.Name)
If Err <> 0 Then
Workbooks.Open f1
Else
DejaOuvert = True
End If
On Error GoTo 0
Workbooks.Open f1
With Workbooks(wb).Sheets("feuil1")
.Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
.Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
If Not DejaOuvert Then Workbooks(f1.Name).Close False
Next
End Sub
'========================== >>
FS
---
Frédéric Sigonneau
http://frederic.sigonneau.free.fr
Bonjour,
J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs situés
dans le répertoire Truc, de façon à remplir un tableau "récap" dans le
classeur actif, puis de les refermer sans enregistrer.
Je souhaiterais que la procédure fonctionne également si certains classeurs
sont déjà ouverts, et dans ce cas les laisser ouverts après copie des
données, et les autres classeurs qui étaient fermés, les refermer après coup.
Merci d'avance,
Ggal
Sub Test()
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
Workbooks.Open f1
With Workbooks(wb).Sheets("feuil1")
..Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
..Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
Workbooks(f1.Name).Close False
Next
End Sub
Comme je l'avais dit, peu testé. J'avais oublié de désactivé l'instruction initiale d'ouverture des classeurs. Ça devrait aller mieux comme ça :
'========================= Sub Test() Dim Wbk As Workbook, DejaOuvert As Boolean wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc On Error Resume Next Set Wbk = Workbooks(f1.Name) If Err <> 0 Then Workbooks.Open f1 Else DejaOuvert = True End If On Error GoTo 0 ' Workbooks.Open f1 '<<<<<<<<< bis repetita non placent With Workbooks(wb).Sheets("feuil1") .Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") .Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 If Not DejaOuvert Then Workbooks(f1.Name).Close False Next End Sub '========================== FS --- Frédéric Sigonneau http://frederic.sigonneau.free.fr
Non ça ne marche pas. On me propose de rouvrir le fichier alors qu'il était fermé. Et quand il est ouvert, même message. Ggal
Pas vraiment testé, juste pour l'idée :
'========================= >> Sub Test() Dim Wbk As Workbook, DejaOuvert As Boolean wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc On Error Resume Next Set Wbk = Workbooks(f1.Name) If Err <> 0 Then Workbooks.Open f1 Else DejaOuvert = True End If On Error GoTo 0 Workbooks.Open f1 With Workbooks(wb).Sheets("feuil1") .Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") .Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 If Not DejaOuvert Then Workbooks(f1.Name).Close False Next End Sub '========================== >> FS --- Frédéric Sigonneau http://frederic.sigonneau.free.fr
Bonjour,
J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs situés dans le répertoire Truc, de façon à remplir un tableau "récap" dans le classeur actif, puis de les refermer sans enregistrer. Je souhaiterais que la procédure fonctionne également si certains classeurs sont déjà ouverts, et dans ce cas les laisser ouverts après copie des données, et les autres classeurs qui étaient fermés, les refermer après coup.
Merci d'avance,
Ggal
Sub Test() wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc Workbooks.Open f1 With Workbooks(wb).Sheets("feuil1") ..Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") ..Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 Workbooks(f1.Name).Close False Next End Sub
francois.forcet
Salut à toi Je te propose ton code modifié ainsi :
wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc For i = 1 To Workbooks.Count If Workbooks(i).Name = f1.Name Then Ouvert = 1 Exit For End If Next If Ouvert = 1 Then Workbooks(i).Activate Else Workbooks.Open f1 End If With Workbooks(wb).Sheets("feuil1") .Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") .Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 If Ouvert <> 1 Then Workbooks(f1.Name).Close False End If Ouvert = "" Next
Celà devrait te convenir Dis moi !!!!
Salut à toi
Je te propose ton code modifié ainsi :
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
For i = 1 To Workbooks.Count
If Workbooks(i).Name = f1.Name Then
Ouvert = 1
Exit For
End If
Next
If Ouvert = 1 Then
Workbooks(i).Activate
Else
Workbooks.Open f1
End If
With Workbooks(wb).Sheets("feuil1")
.Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
.Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
If Ouvert <> 1 Then
Workbooks(f1.Name).Close False
End If
Ouvert = ""
Next
Salut à toi Je te propose ton code modifié ainsi :
wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc For i = 1 To Workbooks.Count If Workbooks(i).Name = f1.Name Then Ouvert = 1 Exit For End If Next If Ouvert = 1 Then Workbooks(i).Activate Else Workbooks.Open f1 End If With Workbooks(wb).Sheets("feuil1") .Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") .Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 If Ouvert <> 1 Then Workbooks(f1.Name).Close False End If Ouvert = "" Next
Celà devrait te convenir Dis moi !!!!
GGAL
La solution de Frédéric fonctionne mieux. Mais celle de François correspond plus à mes attentes : Si le fichier est ouvert, il reste ouvert. Si le fichier est fermé, on l'ouvre puis on le ferme sans l'entregistrer. Toutefois, la variable i apparaît deux fois, d'abord dans le comptage des classeurs, et ensuite en variable de cellules. J'ai les ai donc séparées en i et en j.
Merci à tous.
Ggal
Salut à toi Je te propose ton code modifié ainsi :
wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc For i = 1 To Workbooks.Count If Workbooks(i).Name = f1.Name Then Ouvert = 1 Exit For End If Next If Ouvert = 1 Then Workbooks(i).Activate Else Workbooks.Open f1 End If With Workbooks(wb).Sheets("feuil1") .Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") .Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 If Ouvert <> 1 Then Workbooks(f1.Name).Close False End If Ouvert = "" Next
Celà devrait te convenir Dis moi !!!!
La solution de Frédéric fonctionne mieux. Mais celle de François correspond
plus à mes attentes : Si le fichier est ouvert, il reste ouvert. Si le
fichier est fermé, on l'ouvre puis on le ferme sans l'entregistrer.
Toutefois, la variable i apparaît deux fois, d'abord dans le comptage des
classeurs, et ensuite en variable de cellules. J'ai les ai donc séparées en i
et en j.
Merci à tous.
Ggal
Salut à toi
Je te propose ton code modifié ainsi :
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
For i = 1 To Workbooks.Count
If Workbooks(i).Name = f1.Name Then
Ouvert = 1
Exit For
End If
Next
If Ouvert = 1 Then
Workbooks(i).Activate
Else
Workbooks.Open f1
End If
With Workbooks(wb).Sheets("feuil1")
.Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
.Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
If Ouvert <> 1 Then
Workbooks(f1.Name).Close False
End If
Ouvert = ""
Next
La solution de Frédéric fonctionne mieux. Mais celle de François correspond plus à mes attentes : Si le fichier est ouvert, il reste ouvert. Si le fichier est fermé, on l'ouvre puis on le ferme sans l'entregistrer. Toutefois, la variable i apparaît deux fois, d'abord dans le comptage des classeurs, et ensuite en variable de cellules. J'ai les ai donc séparées en i et en j.
Merci à tous.
Ggal
Salut à toi Je te propose ton code modifié ainsi :
wb = ActiveWorkbook.Name chemin = ActiveWorkbook.Path & "Truc" Set fs = CreateObject("scripting.filesystemobject") Set f = fs.getfolder(chemin) Set fc = f.Files For Each f1 In fc For i = 1 To Workbooks.Count If Workbooks(i).Name = f1.Name Then Ouvert = 1 Exit For End If Next If Ouvert = 1 Then Workbooks(i).Activate Else Workbooks.Open f1 End If With Workbooks(wb).Sheets("feuil1") .Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1") .Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2") End With i = i + 1 If Ouvert <> 1 Then Workbooks(f1.Name).Close False End If Ouvert = "" Next