Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Commentaires

14 réponses
Avatar
Michel MTO
Bonjour à toutes et à tous,

Quelqu'un aurait-il un code Vba pour recopier tous les commentaires de
plusieurs colonnes, dans la première feuille d'un nouveau classeur.

J'explique plus précisement :

Je voudrais créer un bouton (formulaire) qui déclencherait une macro, qui
irait me chercher toutes les cellules qui contiennent un commentaire dans
des colonnes précises (et toujours les mêmes), puis recopier, s'il y en a,
les commentaires en créant un nouveau classeur (workbooks.add), dans la 1ère
feuille en sautant une ligne pour chaque nouveau commentaire (je ne voudrais
pas que tous les commentaires se mettent dans la même cellule dans le
classeur de destination).

Merci pour aide

Michel MTO

4 réponses

1 2
Avatar
Daniel.C
Sub RecopierCommentaires()
Dim c As Range, Ligne As Long, Plage As Range
Dim ResAdr, Sh As Worksheet
Set Sh = ActiveSheet
'pour les colonnes C, D et F; à modifier
' Set Plage = Intersect(Range("C:D,F:F"), ActiveSheet.UsedRange)
Set Plage = Intersect(Range("AN:AN, BP:BP, CP:CP, DO:DO, FC:FC"), _
ActiveSheet.UsedRange)

Workbooks.Add 1
Ligne = 1
Set c = Plage.Find("*", Plage(1, 1), LookIn:=xlComments, _
SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not c Is Nothing Then
ResAdr = c.Address
Do
Cells(Ligne, 1) = c.Offset(, -c.Column + 2)
Cells(Ligne, 1).WrapText = False
Cells(Ligne, 1) = Replace(Cells(Ligne, 1).Value, Chr(10), "
")
Cells(Ligne, 2) = c.Comment.Text
Cells(Ligne, 2).WrapText = False
Cells(Ligne, 2) = Replace(Cells(Ligne, 2).Value, Chr(10), "
")
Ligne = Ligne + 2

Set c = Plage.FindNext(c)
Loop While c.Address <> ResAdr And Not c Is Nothing
End If

End Sub

Daniel

çà fonctionne très bien, merci.

j'ai rajouté dans le code ceci ==>
Do
Cells(Ligne, 1) = c.Offset(, -c.Column + 2)
==>Cells(Ligne, 1).WrapText = False
Cells(Ligne, 2) = c.Comment.Text
==>Cells(Ligne, 1).WrapText = False
Ligne = Ligne + 2

cà marche bien, par contre j'ai un petit carré après chaque "entrée=retour
chariot" dans la cellule. Comment remplacer ces petits carrés par un espace.
(Attention quand je clique sur la cellule on ne les voit pas, c'est
simplement en visuel)
Suis je clair ?

Puis juste pour ma formation perso, peux tu m'expliquer :
Var = Plage(1, 1).Address
et
Plage(1, 1) dans Set c = Plage.Find("*", Plage(1, 1), LookIn:=xlComments,
SearchOrder:=xlByRows, SearchDirection:=xlNext)

merci

Michel

"Daniel.C" a écrit dans le message de
news:
Bonjour.
Essaie :

Sub RecopierCommentaires()
Dim c As Range, Ligne As Long, Plage As Range
Dim ResAdr, Sh As Worksheet
Set Sh = ActiveSheet
'pour les colonnes C, D et F; à modifier
'Set Plage = Intersect(Range("C:D,F:F"), ActiveSheet.UsedRange)
Set Plage = Intersect(Range("AN:AN, BP:BP, CP:CP, DO:DO, FC:FC"), _
ActiveSheet.UsedRange)

Workbooks.Add 1
Ligne = 1
Var = Plage(1, 1).Address
Set c = Plage.Find("*", Plage(1, 1), LookIn:=xlComments, _
SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not c Is Nothing Then
ResAdr = c.Address
Do
Cells(Ligne, 1) = c.Offset(, -c.Column + 2)
Cells(Ligne, 2) = c.Comment.Text

Ligne = Ligne + 2

Set c = Plage.FindNext(c)
Loop While c.Address <> ResAdr And Not c Is Nothing
End If
End Sub

Daniel

Super Daniel çà fonctionne bien merci.
Un petit truc en plus :
Je voudrais ramener le nom correspondant (de la cellule qui contient un
commentaire) et qui se trouve dans la colonne B, et toujours dans la
colonne B.
Comment faire pour lui dire que s'il trouve un commentaire, tu vas chercher
sur la même ligne le contenu de la cellule se trouvant dans la colonne B et
tu la recopie dans le nouveau classeur sur la même ligne que le commentaire
(avant le commentaire par exemple)

Merci

Michel

"Daniel.C" a écrit dans le message de
news:%
Bonjour.
La syntaxe correcte est la suivante :
Set Plage = Intersect(Range("AN:AN, BP:BP, CP:CP, DO:DO, FC:FC"), _
ActiveSheet.UsedRange)
Daniel


Après avoir essayé ta proposition, l'erreur suivante est retournée :

Erreur de compilation :
Nb d'arguments incorrect ou affectation de prpriété incorrecte

A priori c'est sur cette instruction qu'il bloque, puisqu'il me la
sélectionne par défaut :
Set Plage = Intersect(Range("AN:AN", "BP:BP", "CP:CP", "DO:DO", "FC:FC"),
ActiveSheet.UsedRange)

??????

Merci
Michel

.
"Daniel.C" a écrit dans le message de
news:%
Bonjour.
Essaie :

Sub RecopierCommentaires()
Dim c As Range, Ligne As Long, Plage As Range
Dim ResAdr, Sh As Worksheet
Set Sh = ActiveSheet
'pour les colonnes C, D et F; à modifier
Set Plage = Intersect(Range("C:D,F:F"), ActiveSheet.UsedRange)
Workbooks.Add 1
Ligne = 1
Set c = Plage.Find("*", LookIn:=xlComments)
If Not c Is Nothing Then
ResAdr = c.Address
Do
Cells(Ligne, 1) = c.Address(0, 0)
Cells(Ligne, 2) = c.Comment.Text
Ligne = Ligne + 2

Set c = Plage.FindNext(c)
Loop While c.Address <> ResAdr And Not c Is Nothing
End If
End Sub

Cordialement.
Daniel

Bonjour à toutes et à tous,

Quelqu'un aurait-il un code Vba pour recopier tous les commentaires de
plusieurs colonnes, dans la première feuille d'un nouveau classeur.

J'explique plus précisement :

Je voudrais créer un bouton (formulaire) qui déclencherait une macro,
qui irait me chercher toutes les cellules qui contiennent un
commentaire dans des colonnes précises (et toujours les mêmes), puis
recopier, s'il y en a, les commentaires en créant un nouveau classeur
(workbooks.add), dans la 1ère feuille en sautant une ligne pour chaque
nouveau commentaire (je ne voudrais pas que tous les commentaires se
mettent dans la même cellule dans le classeur de destination).

Merci pour aide

Michel MTO
Avatar
Michel MTO
Super, c'est exactement ce qu'il me fallait, merci encore une fois

Michel

"Daniel.C" a écrit dans le message de
news:
Sub RecopierCommentaires()
Dim c As Range, Ligne As Long, Plage As Range
Dim ResAdr, Sh As Worksheet
Set Sh = ActiveSheet
'pour les colonnes C, D et F; à modifier
' Set Plage = Intersect(Range("C:D,F:F"), ActiveSheet.UsedRange)
Set Plage = Intersect(Range("AN:AN, BP:BP, CP:CP, DO:DO, FC:FC"), _
ActiveSheet.UsedRange)

Workbooks.Add 1
Ligne = 1
Set c = Plage.Find("*", Plage(1, 1), LookIn:=xlComments, _
SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not c Is Nothing Then
ResAdr = c.Address
Do
Cells(Ligne, 1) = c.Offset(, -c.Column + 2)
Cells(Ligne, 1).WrapText = False
Cells(Ligne, 1) = Replace(Cells(Ligne, 1).Value, Chr(10), "
")
Cells(Ligne, 2) = c.Comment.Text
Cells(Ligne, 2).WrapText = False
Cells(Ligne, 2) = Replace(Cells(Ligne, 2).Value, Chr(10), "
")
Ligne = Ligne + 2

Set c = Plage.FindNext(c)
Loop While c.Address <> ResAdr And Not c Is Nothing
End If

End Sub

Daniel

> çà fonctionne très bien, merci.
>
> j'ai rajouté dans le code ceci ==>
> Do
> Cells(Ligne, 1) = c.Offset(, -c.Column + 2)
> ==>Cells(Ligne, 1).WrapText = False
> Cells(Ligne, 2) = c.Comment.Text
> ==>Cells(Ligne, 1).WrapText = False
> Ligne = Ligne + 2
>
> cà marche bien, par contre j'ai un petit carré après chaque


"entrée=retour
> chariot" dans la cellule. Comment remplacer ces petits carrés par un


espace.
> (Attention quand je clique sur la cellule on ne les voit pas, c'est
> simplement en visuel)
> Suis je clair ?
>
> Puis juste pour ma formation perso, peux tu m'expliquer :
> Var = Plage(1, 1).Address
> et
> Plage(1, 1) dans Set c = Plage.Find("*", Plage(1, 1),


LookIn:=xlComments,
> SearchOrder:=xlByRows, SearchDirection:=xlNext)
>
> merci
>
> Michel
>
> "Daniel.C" a écrit dans le message de
> news:
>> Bonjour.
>> Essaie :
>>
>> Sub RecopierCommentaires()
>> Dim c As Range, Ligne As Long, Plage As Range
>> Dim ResAdr, Sh As Worksheet
>> Set Sh = ActiveSheet
>> 'pour les colonnes C, D et F; à modifier
>> 'Set Plage = Intersect(Range("C:D,F:F"), ActiveSheet.UsedRange)
>> Set Plage = Intersect(Range("AN:AN, BP:BP, CP:CP, DO:DO, FC:FC"), _
>> ActiveSheet.UsedRange)
>>
>> Workbooks.Add 1
>> Ligne = 1
>> Var = Plage(1, 1).Address
>> Set c = Plage.Find("*", Plage(1, 1), LookIn:=xlComments, _
>> SearchOrder:=xlByRows, SearchDirection:=xlNext)
>> If Not c Is Nothing Then
>> ResAdr = c.Address
>> Do
>> Cells(Ligne, 1) = c.Offset(, -c.Column + 2)
>> Cells(Ligne, 2) = c.Comment.Text
>>
>> Ligne = Ligne + 2
>>
>> Set c = Plage.FindNext(c)
>> Loop While c.Address <> ResAdr And Not c Is Nothing
>> End If
>> End Sub
>>
>> Daniel
>>
>>> Super Daniel çà fonctionne bien merci.
>>> Un petit truc en plus :
>>> Je voudrais ramener le nom correspondant (de la cellule qui contient


un
>>> commentaire) et qui se trouve dans la colonne B, et toujours dans la
>>> colonne B.
>>> Comment faire pour lui dire que s'il trouve un commentaire, tu vas


chercher
>>> sur la même ligne le contenu de la cellule se trouvant dans la colonne


B et
>>> tu la recopie dans le nouveau classeur sur la même ligne que le


commentaire
>>> (avant le commentaire par exemple)
>>>
>>> Merci
>>>
>>> Michel
>>>
>>> "Daniel.C" a écrit dans le message de
>>> news:%
>>>> Bonjour.
>>>> La syntaxe correcte est la suivante :
>>>> Set Plage = Intersect(Range("AN:AN, BP:BP, CP:CP, DO:DO, FC:FC"), _
>>>> ActiveSheet.UsedRange)
>>>> Daniel
>>>>
>>>>
>>>>> Après avoir essayé ta proposition, l'erreur suivante est retournée :
>>>>>
>>>>> Erreur de compilation :
>>>>> Nb d'arguments incorrect ou affectation de prpriété incorrecte
>>>>>
>>>>> A priori c'est sur cette instruction qu'il bloque, puisqu'il me la
>>>>> sélectionne par défaut :
>>>>> Set Plage = Intersect(Range("AN:AN", "BP:BP", "CP:CP", "DO:DO",


"FC:FC"),
>>>>> ActiveSheet.UsedRange)
>>>>>
>>>>> ??????
>>>>>
>>>>> Merci
>>>>> Michel
>>>>>
>>>>> .
>>>>> "Daniel.C" a écrit dans le message de
>>>>> news:%
>>>>>> Bonjour.
>>>>>> Essaie :
>>>>>>
>>>>>> Sub RecopierCommentaires()
>>>>>> Dim c As Range, Ligne As Long, Plage As Range
>>>>>> Dim ResAdr, Sh As Worksheet
>>>>>> Set Sh = ActiveSheet
>>>>>> 'pour les colonnes C, D et F; à modifier
>>>>>> Set Plage = Intersect(Range("C:D,F:F"), ActiveSheet.UsedRange)
>>>>>> Workbooks.Add 1
>>>>>> Ligne = 1
>>>>>> Set c = Plage.Find("*", LookIn:=xlComments)
>>>>>> If Not c Is Nothing Then
>>>>>> ResAdr = c.Address
>>>>>> Do
>>>>>> Cells(Ligne, 1) = c.Address(0, 0)
>>>>>> Cells(Ligne, 2) = c.Comment.Text
>>>>>> Ligne = Ligne + 2
>>>>>>
>>>>>> Set c = Plage.FindNext(c)
>>>>>> Loop While c.Address <> ResAdr And Not c Is Nothing
>>>>>> End If
>>>>>> End Sub
>>>>>>
>>>>>> Cordialement.
>>>>>> Daniel
>>>>>>
>>>>>>> Bonjour à toutes et à tous,
>>>>>>>
>>>>>>> Quelqu'un aurait-il un code Vba pour recopier tous les


commentaires de
>>>>>>> plusieurs colonnes, dans la première feuille d'un nouveau


classeur.
>>>>>>>
>>>>>>> J'explique plus précisement :
>>>>>>>
>>>>>>> Je voudrais créer un bouton (formulaire) qui déclencherait une


macro,
>>>>>>> qui irait me chercher toutes les cellules qui contiennent un
>>>>>>> commentaire dans des colonnes précises (et toujours les mêmes),


puis
>>>>>>> recopier, s'il y en a, les commentaires en créant un nouveau


classeur
>>>>>>> (workbooks.add), dans la 1ère feuille en sautant une ligne pour


chaque
>>>>>>> nouveau commentaire (je ne voudrais pas que tous les commentaires


se
>>>>>>> mettent dans la même cellule dans le classeur de destination).
>>>>>>>
>>>>>>> Merci pour aide
>>>>>>>
>>>>>>> Michel MTO


Avatar
michdenis
Un fichier exemple : http://cjoint.com/?ejpcqdBCpO

Ta question : "code Vba pour recopier tous les commentaires de
plusieurs colonnes"

Il y a une différence entre copier un commentaire et copier le texte
contenu d'un commentaire. Un commentaire, en plus du formatage
particulier pourrait aussi contenir une image...

Ça prend quand même un minimum de précision dans la question.



"Michel MTO" a écrit dans le message de groupe de discussion :
hpmksm$dgp$
Donc j'ai essayé ton code qui me parait court et clair, mais une erreur
survient :
Erreur d'excécution 1004, La méthode 'Intersect' de l'objet '_Global' a
échoué ???

J'ai remplacé
If Not Intersect(C.Parent, .Range("A:A", "D:D")) Is Nothing Then
par
if Not Intersect(C.Parent, Range("AN:AN"), Range("BP:BP"), Range("CP:CP"),
Range("DO:DO"), Range("FC:FC")) Is Nothing Then
car il ne l'acceptait pas non plus.

Une idée de résolution ??


"michdenis" a écrit dans le message de
news:
Bonjour,

Une autre approche :

Tu dois adapter le nom de la feuille source "Sheet1"
et les colonnes dans lesquelles se retrouvent tes
commentaires Range("A:A", "D:D")

'--------------------------------------
Sub test()
Dim Wk As Workbook, C As Comment, A As Integer

Set Wk = Workbooks.Add
With ThisWorkbook
With .Worksheets("Sheet1")
For Each C In .Comments
If Not Intersect(C.Parent, .Range("A:A", "D:D")) _
Is Nothing Then
C.Parent.Copy
A = A + 1
Wk.Worksheets(1).Range("A" & A). _
PasteSpecial (xlPasteComments)
End If
Next
End With
End With
End Sub
'--------------------------------------




"Michel MTO" a écrit dans le message de groupe


de discussion :
hpk45d$t9t$
Bonjour à toutes et à tous,

Quelqu'un aurait-il un code Vba pour recopier tous les commentaires de
plusieurs colonnes, dans la première feuille d'un nouveau classeur.

J'explique plus précisement :

Je voudrais créer un bouton (formulaire) qui déclencherait une macro, qui
irait me chercher toutes les cellules qui contiennent un commentaire dans
des colonnes précises (et toujours les mêmes), puis recopier, s'il y en a,
les commentaires en créant un nouveau classeur (workbooks.add), dans la


1ère
feuille en sautant une ligne pour chaque nouveau commentaire (je ne


voudrais
pas que tous les commentaires se mettent dans la même cellule dans le
classeur de destination).

Merci pour aide

Michel MTO

Avatar
Michel MTO
Denis,

merci pour ton fichier exemple, on apprend jamais assez !!
Désolé, je ne pensais pas avoir été aussi imprécis que cela !!
Le code proposé par Daniel me va très bien

Michel

"michdenis" a écrit dans le message de
news:
Un fichier exemple : http://cjoint.com/?ejpcqdBCpO

Ta question : "code Vba pour recopier tous les commentaires de
plusieurs colonnes"

Il y a une différence entre copier un commentaire et copier le texte
contenu d'un commentaire. Un commentaire, en plus du formatage
particulier pourrait aussi contenir une image...

Ça prend quand même un minimum de précision dans la question.



"Michel MTO" a écrit dans le message de groupe


de discussion :
hpmksm$dgp$
Donc j'ai essayé ton code qui me parait court et clair, mais une erreur
survient :
Erreur d'excécution 1004, La méthode 'Intersect' de l'objet '_Global' a
échoué ???

J'ai remplacé
If Not Intersect(C.Parent, .Range("A:A", "D:D")) Is Nothing Then
par
if Not Intersect(C.Parent, Range("AN:AN"), Range("BP:BP"), Range("CP:CP"),
Range("DO:DO"), Range("FC:FC")) Is Nothing Then
car il ne l'acceptait pas non plus.

Une idée de résolution ??


"michdenis" a écrit dans le message de
news:
> Bonjour,
>
> Une autre approche :
>
> Tu dois adapter le nom de la feuille source "Sheet1"
> et les colonnes dans lesquelles se retrouvent tes
> commentaires Range("A:A", "D:D")
>
> '--------------------------------------
> Sub test()
> Dim Wk As Workbook, C As Comment, A As Integer
>
> Set Wk = Workbooks.Add
> With ThisWorkbook
> With .Worksheets("Sheet1")
> For Each C In .Comments
> If Not Intersect(C.Parent, .Range("A:A", "D:D")) _
> Is Nothing Then
> C.Parent.Copy
> A = A + 1
> Wk.Worksheets(1).Range("A" & A). _
> PasteSpecial (xlPasteComments)
> End If
> Next
> End With
> End With
> End Sub
> '--------------------------------------
>
>
>
>
> "Michel MTO" a écrit dans le message de groupe
de discussion :
> hpk45d$t9t$
> Bonjour à toutes et à tous,
>
> Quelqu'un aurait-il un code Vba pour recopier tous les commentaires de
> plusieurs colonnes, dans la première feuille d'un nouveau classeur.
>
> J'explique plus précisement :
>
> Je voudrais créer un bouton (formulaire) qui déclencherait une macro,


qui
> irait me chercher toutes les cellules qui contiennent un commentaire


dans
> des colonnes précises (et toujours les mêmes), puis recopier, s'il y en


a,
> les commentaires en créant un nouveau classeur (workbooks.add), dans la
1ère
> feuille en sautant une ligne pour chaque nouveau commentaire (je ne
voudrais
> pas que tous les commentaires se mettent dans la même cellule dans le
> classeur de destination).
>
> Merci pour aide
>
> Michel MTO
>
1 2