Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Echec de copie de cellules

Echec de copie de cellules

10 réponses
Avatar
PyxosLeDisciple
Salut à vous,

Grâce au code qui suit, j'essaie de copier certaines cellules d'un
classeur pour les transférer dans un autre fichier.
Tout semble bien se passer car la mise en forme est copiée pour les
trois colonnes.
Toutefois, seules les valeurs de la première colonne soit recopiée.

Que faire pour remédier à ce problème ?
Que faire pour copier "sauvagement" toute la ligne d'un coup ?

Voici le code :
Public Sub RecupererActions()

FilePth = "C:\Dev\TestExcel\data\"
FileNm = Dir(FilePth & "*.xls")

Do While FileNm <> ""
Workbooks.Open FilePth & FileNm
For Each TmpRng In ActiveWorkbook.Sheets(3).Range("C115:F123").Rows
If TmpRng.Range("A1").Value = "" Then
i =
Workbooks("Master.xls").Sheets(1).Range("A65536").End(xlUp).Row + 1
TmpRng.Range("B1").Copy
Workbooks("Master.xls").Sheets(1).Range("A" & i)
TmpRng.Range("C1").Copy
Workbooks("Master.xls").Sheets(1).Range("C" & i)
TmpRng.Range("D1").Copy
Workbooks("Master.xls").Sheets(1).Range("B" & i)
End If
Next
FileNm = Dir
Loop

End Sub
Signaler un problème avec ce contenu

10 réponses

Supprimer
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
Avatar
John Fuss
Il te afut utiliser Union()

qui te permettra avant de faire range.copy et pis Range.Copy (qui efface
l'ancienne), etc...

tu fais Union(Range1, Range2, Range3).Copy

et pis voilà

John


"PyxosLeDisciple" a écrit dans le message de
news:
Salut à vous,

Grâce au code qui suit, j'essaie de copier certaines cellules d'un
classeur pour les transférer dans un autre fichier.
Tout semble bien se passer car la mise en forme est copiée pour les
trois colonnes.
Toutefois, seules les valeurs de la première colonne soit recopiée.

Que faire pour remédier à ce problème ?
Que faire pour copier "sauvagement" toute la ligne d'un coup ?

Voici le code :
Public Sub RecupererActions()

FilePth = "C:DevTestExceldata"
FileNm = Dir(FilePth & "*.xls")

Do While FileNm <> ""
Workbooks.Open FilePth & FileNm
For Each TmpRng In ActiveWorkbook.Sheets(3).Range("C115:F123").Rows
If TmpRng.Range("A1").Value = "" Then
i > Workbooks("Master.xls").Sheets(1).Range("A65536").End(xlUp).Row + 1
TmpRng.Range("B1").Copy
Workbooks("Master.xls").Sheets(1).Range("A" & i)
TmpRng.Range("C1").Copy
Workbooks("Master.xls").Sheets(1).Range("C" & i)
TmpRng.Range("D1").Copy
Workbooks("Master.xls").Sheets(1).Range("B" & i)
End If
Next
FileNm = Dir
Loop

End Sub



Avatar
PyxosLeDisciple
John,

Pourrais-tu intégrer ta remarque afin que je comprenne comment
l'utiliser car étant novice dans le domaine, je ne vois pas comment en
tenir compte ?

Merci d'avance.

John Fuss a écrit:
Il te afut utiliser Union()

qui te permettra avant de faire range.copy et pis Range.Copy (qui efface
l'ancienne), etc...

tu fais Union(Range1, Range2, Range3).Copy

et pis voilà

John


"PyxosLeDisciple" a écrit dans le message de
news:

Salut à vous,

Grâce au code qui suit, j'essaie de copier certaines cellules d'un
classeur pour les transférer dans un autre fichier.
Tout semble bien se passer car la mise en forme est copiée pour les
trois colonnes.
Toutefois, seules les valeurs de la première colonne soit recopiée.

Que faire pour remédier à ce problème ?
Que faire pour copier "sauvagement" toute la ligne d'un coup ?

Voici le code :
Public Sub RecupererActions()

FilePth = "C:DevTestExceldata"
FileNm = Dir(FilePth & "*.xls")

Do While FileNm <> ""
Workbooks.Open FilePth & FileNm
For Each TmpRng In ActiveWorkbook.Sheets(3).Range("C115:F123").Rows
If TmpRng.Range("A1").Value = "" Then
i >>Workbooks("Master.xls").Sheets(1).Range("A65536").End(xlUp).Row + 1
TmpRng.Range("B1").Copy
Workbooks("Master.xls").Sheets(1).Range("A" & i)
TmpRng.Range("C1").Copy
Workbooks("Master.xls").Sheets(1).Range("C" & i)
TmpRng.Range("D1").Copy
Workbooks("Master.xls").Sheets(1).Range("B" & i)
End If
Next
FileNm = Dir
Loop

End Sub








Avatar
John Fuss
Explique concretement ce que tu veux faire car ton code est bizarre (il
manque des trucs) tu utilises .Copy mais tu ne colle pas (.Paste) donc
dis-nous en un peu plus et je te repondrai.

John


"PyxosLeDisciple" a écrit dans le message de
news:
John,

Pourrais-tu intégrer ta remarque afin que je comprenne comment
l'utiliser car étant novice dans le domaine, je ne vois pas comment en
tenir compte ?

Merci d'avance.

John Fuss a écrit:
Il te afut utiliser Union()

qui te permettra avant de faire range.copy et pis Range.Copy (qui efface
l'ancienne), etc...

tu fais Union(Range1, Range2, Range3).Copy

et pis voilà

John


"PyxosLeDisciple" a écrit dans le message de
news:

Salut à vous,

Grâce au code qui suit, j'essaie de copier certaines cellules d'un
classeur pour les transférer dans un autre fichier.
Tout semble bien se passer car la mise en forme est copiée pour les
trois colonnes.
Toutefois, seules les valeurs de la première colonne soit recopiée.

Que faire pour remédier à ce problème ?
Que faire pour copier "sauvagement" toute la ligne d'un coup ?

Voici le code :
Public Sub RecupererActions()

FilePth = "C:DevTestExceldata"
FileNm = Dir(FilePth & "*.xls")

Do While FileNm <> ""
Workbooks.Open FilePth & FileNm
For Each TmpRng In
ActiveWorkbook.Sheets(3).Range("C115:F123").Rows



If TmpRng.Range("A1").Value = "" Then
i > >>Workbooks("Master.xls").Sheets(1).Range("A65536").End(xlUp).Row + 1
TmpRng.Range("B1").Copy
Workbooks("Master.xls").Sheets(1).Range("A" & i)
TmpRng.Range("C1").Copy
Workbooks("Master.xls").Sheets(1).Range("C" & i)
TmpRng.Range("D1").Copy
Workbooks("Master.xls").Sheets(1).Range("B" & i)
End If
Next
FileNm = Dir
Loop

End Sub











Avatar
PyxosLeDisciple
Excusez moi pour mon manque de clarté. Je vais essayer de vous exposer
mon problème.

Dans un premier fichier, j'ai plusieurs feuilles qui ont le même modèle.
Celui ci est composé de plusieurs tableaux et mon objectif est pour un
certain tableau situé dans la zone définie par la zone
"Range("C115:F123")" de copier toutes lignes pour lesquelles la
condition TmpRng.Range("A1").Value = "" est satisfaite. En français la
condition est la suivante : si la cellule est vide (date non renseignée)
alors copie les 3 cellules B, C et D dans l'autre fichier.

Toutefois, je préfèrerais copier toute la ligne dès que la condition est
satisfaite.

Ainsi pour me résumer, dans un premier fichier, je parcours toutes les
feuilles sauf la première, et en analysant une zone déterminée, je teste
une condition. Si celle-ci est validée, je copie la ligne dans un AUTRE
fichier, et toujours dans la même feuille.
Au final, j'aurais regroupé dans un même fichier des lignes provenant de
feuilles différentes.

Suis-je assez clair ?

Je précise que j'ai essayé d'utiliser un code que l'on m'a gracieusement
car je suis actuellement incapable de le créer moi-même mais je ne
demande qu'apprendre.

Merci d'avance

John Fuss a écrit:
Explique concretement ce que tu veux faire car ton code est bizarre (il
manque des trucs) tu utilises .Copy mais tu ne colle pas (.Paste) donc
dis-nous en un peu plus et je te repondrai.

John


"PyxosLeDisciple" a écrit dans le message de
news:

John,

Pourrais-tu intégrer ta remarque afin que je comprenne comment
l'utiliser car étant novice dans le domaine, je ne vois pas comment en
tenir compte ?

Merci d'avance.

John Fuss a écrit:

Il te afut utiliser Union()

qui te permettra avant de faire range.copy et pis Range.Copy (qui efface
l'ancienne), etc...

tu fais Union(Range1, Range2, Range3).Copy

et pis voilà

John


"PyxosLeDisciple" a écrit dans le message de
news:


Salut à vous,

Grâce au code qui suit, j'essaie de copier certaines cellules d'un
classeur pour les transférer dans un autre fichier.
Tout semble bien se passer car la mise en forme est copiée pour les
trois colonnes.
Toutefois, seules les valeurs de la première colonne soit recopiée.

Que faire pour remédier à ce problème ?
Que faire pour copier "sauvagement" toute la ligne d'un coup ?

Voici le code :
Public Sub RecupererActions()

FilePth = "C:DevTestExceldata"
FileNm = Dir(FilePth & "*.xls")

Do While FileNm <> ""
Workbooks.Open FilePth & FileNm
For Each TmpRng In


ActiveWorkbook.Sheets(3).Range("C115:F123").Rows



If TmpRng.Range("A1").Value = "" Then
i >>>>Workbooks("Master.xls").Sheets(1).Range("A65536").End(xlUp).Row + 1
TmpRng.Range("B1").Copy
Workbooks("Master.xls").Sheets(1).Range("A" & i)
TmpRng.Range("C1").Copy
Workbooks("Master.xls").Sheets(1).Range("C" & i)
TmpRng.Range("D1").Copy
Workbooks("Master.xls").Sheets(1).Range("B" & i)
End If
Next
FileNm = Dir
Loop

End Sub














Avatar
Denis Michon
Bonjour PyxosLeDisciple,


Essaie ceci : Tu renseignes le nom des feuilles par leur index...Tu dois t'assurer que les feuilles sont réellement à la
même position pour chacun des classeurs et qu'elles ne changeront pas de position...

Je suis loin d'être sûr d'avoir saisi ta demande !

'---------------------------------
Public Sub RecupererActions()

FilePth = "C:DevTestExceldata"
FileNm = Dir(FilePth & "*.xls")

'empêche le rafraîchissement de l'écran
Application.ScreenUpdating = False

Do While FileNm <> ""
Workbooks.Open FilePth & FileNm
For Each TmpRng In Sheets(3).Range("C115:F123").Rows
If TmpRng.Range("A1").Value = "" Then
With Workbooks("Master.xls").Sheets(1)
i = .Range("A65536").End(xlUp).Row + 1
TmpRng.Range("B1").Copy .Range("A" & i)
TmpRng.Range("C1").Copy .Range("C" & i)
TmpRng.Range("D1").Copy .Range("B" & i)
End With
End If
Next
'Ferme le classeur que tu viens juste d'ouvrir
ActiveWorkbook.Close False
FileNm = Dir
Loop

End Sub
'---------------------------------


Salutations!


"PyxosLeDisciple" a écrit dans le message de news:
Salut à vous,

Grâce au code qui suit, j'essaie de copier certaines cellules d'un
classeur pour les transférer dans un autre fichier.
Tout semble bien se passer car la mise en forme est copiée pour les
trois colonnes.
Toutefois, seules les valeurs de la première colonne soit recopiée.

Que faire pour remédier à ce problème ?
Que faire pour copier "sauvagement" toute la ligne d'un coup ?

Voici le code :
Public Sub RecupererActions()

FilePth = "C:DevTestExceldata"
FileNm = Dir(FilePth & "*.xls")

Do While FileNm <> ""
Workbooks.Open FilePth & FileNm
For Each TmpRng In ActiveWorkbook.Sheets(3).Range("C115:F123").Rows
If TmpRng.Range("A1").Value = "" Then
i Workbooks("Master.xls").Sheets(1).Range("A65536").End(xlUp).Row + 1
TmpRng.Range("B1").Copy
Workbooks("Master.xls").Sheets(1).Range("A" & i)
TmpRng.Range("C1").Copy
Workbooks("Master.xls").Sheets(1).Range("C" & i)
TmpRng.Range("D1").Copy
Workbooks("Master.xls").Sheets(1).Range("B" & i)
End If
Next
FileNm = Dir
Loop

End Sub
Avatar
John Fuss
"PyxosLeDisciple" a écrit dans le message de
news:
Excusez moi pour mon manque de clarté. Je vais essayer de vous exposer
mon problème.



Okay

Dans un premier fichier, j'ai plusieurs feuilles qui ont le même modèle.
Celui ci est composé de plusieurs tableaux et mon objectif est pour un
certain tableau situé dans la zone définie par la zone
"Range("C115:F123")"


y'a quoi dans Range("C115:F123") ??? j'ai pas bien compris !

de copier toutes lignes pour lesquelles la
condition TmpRng.Range("A1").Value = "" est satisfaite. En français la
condition est la suivante : si la cellule est vide (date non renseignée)
alors copie les 3 cellules B, C et D dans l'autre fichier.

Toutefois, je préfèrerais copier toute la ligne dès que la condition est
satisfaite.



Pour ça : Range("B1").Entirerow.Copy

Ainsi pour me résumer, dans un premier fichier, je parcours toutes les
feuilles sauf la première, et en analysant une zone déterminée, je teste
une condition. Si celle-ci est validée, je copie la ligne dans un AUTRE
fichier, et toujours dans la même feuille.
Au final, j'aurais regroupé dans un même fichier des lignes provenant de
feuilles différentes.

Suis-je assez clair ?

Je précise que j'ai essayé d'utiliser un code que l'on m'a gracieusement
car je suis actuellement incapable de le créer moi-même mais je ne
demande qu'apprendre.

Merci d'avance




Bon, j'ai compris que tu veux récupérer des lignes en fonction du contenu
d'une cellule de cette ligne dans des feuilles d'un même classeur, Il y a
plusieurs fichiers ou non ? Les lignes récupérées doivent être collées dans
un fichier (lequel ?) dans une feuille précise (laquelle ?). J'ai pas bien
compris ce qu'il y avait dans ton range("C115:F123").

Donne nous des noms, des exemples, etc...

John

Avatar
PyxosLeDisciple
John Fuss a écrit:
"PyxosLeDisciple" a écrit dans le message de
news:

Excusez moi pour mon manque de clarté. Je vais essayer de vous exposer
mon problème.




Okay


Dans un premier fichier, j'ai plusieurs feuilles qui ont le même modèle.
Celui ci est composé de plusieurs tableaux et mon objectif est pour un
certain tableau situé dans la zone définie par la zone
"Range("C115:F123")"



y'a quoi dans Range("C115:F123") ??? j'ai pas bien compris !


C'est un tableau à 4 colonnes qui sont :
- une date, non renseignée si la tâche n'est pas réalisée
- un descriptif de la tâche
- une date de fin théorique
- un responsable de la tâche



de copier toutes lignes pour lesquelles la
condition TmpRng.Range("A1").Value = "" est satisfaite. En français la
condition est la suivante : si la cellule est vide (date non renseignée)
alors copie les 3 cellules B, C et D dans l'autre fichier.

Toutefois, je préfèrerais copier toute la ligne dès que la condition est
satisfaite.




Pour ça : Range("B1").Entirerow.Copy


Ainsi pour me résumer, dans un premier fichier, je parcours toutes les
feuilles sauf la première, et en analysant une zone déterminée, je teste
une condition. Si celle-ci est validée, je copie la ligne dans un AUTRE
fichier, et toujours dans la même feuille.
Au final, j'aurais regroupé dans un même fichier des lignes provenant de
feuilles différentes.

Suis-je assez clair ?

Je précise que j'ai essayé d'utiliser un code que l'on m'a gracieusement
car je suis actuellement incapable de le créer moi-même mais je ne
demande qu'apprendre.

Merci d'avance





Bon, j'ai compris que tu veux récupérer des lignes en fonction du contenu
d'une cellule de cette ligne dans des feuilles d'un même classeur, Il y a
plusieurs fichiers ou non ? Les lignes récupérées doivent être collées dans
un fichier (lequel ?) dans une feuille précise (laquelle ?). J'ai pas bien
compris ce qu'il y avait dans ton range("C115:F123").

Donne nous des noms, des exemples, etc...

John

Soit un fichier "reporting_sem40.xls" qui contient 6 feuilles (une qui

est une page de garde + 5 autres pour 5 projets).
Chaque feuille "projet" contient en particulier une liste des tâches à
effectuer, c'est le range("C115:F123") décrit plus haut et qui est
limité à 9 lignes.

Le but de la macro est de copier (toute la ligne, si c'est plus facile)
les tâches non réalisées (première colonne non renseignée) de chaque
feuille pour les mettre dans un autre fichier que j'appellerai
synthese_sem40.xls.
En ce qui concerne le choix de copier les données dans différentes
feuilles ou non, il pourrait être intéressant que ce soit le cas.


Merci d'avance pour les compléments d'information.

Si je pouvais joindre un fichier cela aurait été plus simple.





--
"Chercher conseil, c'est aller à la fontaine du savoir." Hazrat Ali -
Khalife musulman
"L'idéal de la vie n'est pas l'espoir de devenir parfait, c'est la
volonté d'être toujours meilleur." Ralph Waldo Emerson
"Qui triomphe de lui-même possède la force." Lao-Tseu
Mon site : http://www.desala.org/


Avatar
PyxosLeDisciple
John Fuss a écrit:
"PyxosLeDisciple" a écrit dans le message de
news:

Excusez moi pour mon manque de clarté. Je vais essayer de vous exposer
mon problème.




Okay


Dans un premier fichier, j'ai plusieurs feuilles qui ont le même modèle.
Celui ci est composé de plusieurs tableaux et mon objectif est pour un
certain tableau situé dans la zone définie par la zone
"Range("C115:F123")"



y'a quoi dans Range("C115:F123") ??? j'ai pas bien compris !


C'est un tableau à 4 colonnes qui sont :
- une date, non renseignée si la tâche n'est pas réalisée
- un descriptif de la tâche
- une date de fin théorique
- un responsable de la tâche



de copier toutes lignes pour lesquelles la
condition TmpRng.Range("A1").Value = "" est satisfaite. En français la
condition est la suivante : si la cellule est vide (date non renseignée)
alors copie les 3 cellules B, C et D dans l'autre fichier.

Toutefois, je préfèrerais copier toute la ligne dès que la condition est
satisfaite.




Pour ça : Range("B1").Entirerow.Copy


Ainsi pour me résumer, dans un premier fichier, je parcours toutes les
feuilles sauf la première, et en analysant une zone déterminée, je teste
une condition. Si celle-ci est validée, je copie la ligne dans un AUTRE
fichier, et toujours dans la même feuille.
Au final, j'aurais regroupé dans un même fichier des lignes provenant de
feuilles différentes.

Suis-je assez clair ?

Je précise que j'ai essayé d'utiliser un code que l'on m'a gracieusement
car je suis actuellement incapable de le créer moi-même mais je ne
demande qu'apprendre.

Merci d'avance





Bon, j'ai compris que tu veux récupérer des lignes en fonction du contenu
d'une cellule de cette ligne dans des feuilles d'un même classeur, Il y a
plusieurs fichiers ou non ? Les lignes récupérées doivent être
collées dans

un fichier (lequel ?) dans une feuille précise (laquelle ?). J'ai pas
bien

compris ce qu'il y avait dans ton range("C115:F123").

Donne nous des noms, des exemples, etc...

John

Soit un fichier "reporting_sem40.xls" qui contient 6 feuilles (une qui

est une page de garde + 5 autres pour 5 projets).
Chaque feuille "projet" contient en particulier une liste des tâches à
effectuer, c'est le range("C115:F123") décrit plus haut et qui est
limité à 9 lignes.

Le but de la macro est de copier (toute la ligne, si c'est plus facile)
les tâches non réalisées (première colonne non renseignée) de chaque
feuille pour les mettre dans un autre fichier que j'appellerai
synthese_sem40.xls.
En ce qui concerne le choix de copier les données dans différentes
feuilles ou non, il pourrait être intéressant que ce soit le cas.


Merci d'avance pour les compléments d'information.

Si je pouvais joindre un fichier cela aurait été plus simple.





--
"Chercher conseil, c'est aller à la fontaine du savoir." Hazrat Ali -
Khalife musulman
"L'idéal de la vie n'est pas l'espoir de devenir parfait, c'est la
volonté d'être toujours meilleur." Ralph Waldo Emerson
"Qui triomphe de lui-même possède la force." Lao-Tseu
Mon site : http://www.desala.org/


Avatar
John Fuss
Slt,

je t'ai fait ça vite fait, si tu as un pbl tu m'enverra ton fichier par mail
et dis moi si j'ai bien saisi le pbl

Sub TaMacro()
Dim fichier As String, i As Integer, ra As Range, fName As String

Workbooks.Add 'ajoute un classeur pour stocker la synthèse
Do
'demande un nom pour le fichier de synthèse
fName = Application.GetSaveAsFilename("Fichier de synthèse (*.xls);
*.xls")
Loop Until fName <> False
ActiveWorkbook.SaveAs ThisWorkbook.Path & "" & fName 'le sauvegarde
With Workbooks(fName).Sheets(1)
.Name = "Synthèse" 'renomme la feuille 1
.Range("A1").Formula = "Descriptif" 'met les titres
.Range("B1").Formula = "Date de fin"
.Range("C1").Formula = "Responsable"
End With

ChDrive Left(ThisWorkbook.Path, 1) 'change le lecteur en cours au
lecteur de la macro
ChDir ThisWorkbook.Path 'change le repertoire en cours au rep de la
macro
fichier = Application.GetOpenFilename("Fichier de reporting (*.xls),
*.xls") 'fenetre d'ouverture de fichier
Workbooks.Open fichier 'ouverture du fichier
If Mid(fichier, 2, 1) = ":" Then 'verif si l'utilisateur a pas appuyer
sur Annuler
Do While InStr(fichier, "") <> 0 'debut
'boucle qui permet de recup le nom du fichier
fichier = Right(fichier, Len(fichier) - InStr(fichier, ""))
Loop 'fin
End If

With Workbooks(fichier)
If .Sheets.Count >= 2 Then 'verif si +ieurs feuilles
For i = 2 To .Sheets.Count 'pour chaque feuille sauf la première
With .Sheets(i)
For Each ra In .Range("C115:C123") 'juste C car on test
que ça
If ra.Value = "" Then
'si la cellule date est vide
.Range(ra.Offset(0, 1), ra.Offset(0, 3)).Copy
'copy de la col 'C+1' à 'C+3' (de 'D' à 'F')
Workbooks(fName).Activate 'selectionne le
classeur de synthèse
Workbooks(fName).Sheets(1).Select 'selectionne
la feuille de synthèse
'part de la dernière ligne de la colonne A
'revient à la première ligne remplie en allant
vers le haut
'et se décale d'une ligne vers le bas
'donc se place sur le première ligne vide

Workbooks(fName).Sheets(1).Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste 'colle les lignes copiées
End If
Next
End With
Next
End If
End With
End Sub

John
Avatar
PyxosLeDisciple
Pourrais-tu me transmettre directement une adresse à laquelle je puisse
t'envoyer un message ainsi que le fichier car en essayant ton code, j'ai
eu l'erreur '1004' : fichier inaccessible dès la demande de nom pour le
fichier de synthèse ?

John Fuss a écrit:
Slt,

je t'ai fait ça vite fait, si tu as un pbl tu m'enverra ton fichier par mail
et dis moi si j'ai bien saisi le pbl

Sub TaMacro()
Dim fichier As String, i As Integer, ra As Range, fName As String

Workbooks.Add 'ajoute un classeur pour stocker la synthèse
Do
'demande un nom pour le fichier de synthèse
fName = Application.GetSaveAsFilename("Fichier de synthèse (*.xls);
*.xls")
Loop Until fName <> False
ActiveWorkbook.SaveAs ThisWorkbook.Path & "" & fName 'le sauvegarde
With Workbooks(fName).Sheets(1)
.Name = "Synthèse" 'renomme la feuille 1
.Range("A1").Formula = "Descriptif" 'met les titres
.Range("B1").Formula = "Date de fin"
.Range("C1").Formula = "Responsable"
End With

ChDrive Left(ThisWorkbook.Path, 1) 'change le lecteur en cours au
lecteur de la macro
ChDir ThisWorkbook.Path 'change le repertoire en cours au rep de la
macro
fichier = Application.GetOpenFilename("Fichier de reporting (*.xls),
*.xls") 'fenetre d'ouverture de fichier
Workbooks.Open fichier 'ouverture du fichier
If Mid(fichier, 2, 1) = ":" Then 'verif si l'utilisateur a pas appuyer
sur Annuler
Do While InStr(fichier, "") <> 0 'debut
'boucle qui permet de recup le nom du fichier
fichier = Right(fichier, Len(fichier) - InStr(fichier, ""))
Loop 'fin
End If

With Workbooks(fichier)
If .Sheets.Count >= 2 Then 'verif si +ieurs feuilles
For i = 2 To .Sheets.Count 'pour chaque feuille sauf la première
With .Sheets(i)
For Each ra In .Range("C115:C123") 'juste C car on test
que ça
If ra.Value = "" Then
'si la cellule date est vide
.Range(ra.Offset(0, 1), ra.Offset(0, 3)).Copy
'copy de la col 'C+1' à 'C+3' (de 'D' à 'F')
Workbooks(fName).Activate 'selectionne le
classeur de synthèse
Workbooks(fName).Sheets(1).Select 'selectionne
la feuille de synthèse
'part de la dernière ligne de la colonne A
'revient à la première ligne remplie en allant
vers le haut
'et se décale d'une ligne vers le bas
'donc se place sur le première ligne vide

Workbooks(fName).Sheets(1).Range("A65536").End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste 'colle les lignes copiées
End If
Next
End With
Next
End If
End With
End Sub

John





--
"Chercher conseil, c'est aller à la fontaine du savoir." Hazrat Ali -
Khalife musulman
"L'idéal de la vie n'est pas l'espoir de devenir parfait, c'est la
volonté d'être toujours meilleur." Ralph Waldo Emerson
"Qui triomphe de lui-même possède la force." Lao-Tseu
Mon site : http://www.desala.org/