Copier ou reproduire que les mises en formes conditionnelles
11 réponses
rmill...
Bonjour,
Je dois réussir Í soit copier ou Í reproduire ... que les mises en formes conditionnelles dans une même feuille mais dans 2 classeurs différents.
Mais ... sans ... les formats des cellules.
J'ai passé des heures Í chercher mais il semble y avoir une brèche Í ce niveau.
Au moment de le faire ... les 2 feuilles sont identiques. Donc je peux détecter l'adresse d'une cellule contenant une MFC mais ... comment ... exactement ... la reproduire dans l'autre feuille Í la même adresse?
Bonjour, Je dois réussir Í soit copier ou Í reproduire ... que les mises en formes conditionnelles dans une même feuille mais dans 2 classeurs différents. Mais ... sans ... les formats des cellules. J'ai passé des heures Í chercher mais il semble y avoir une brèche Í ce niveau. Au moment de le faire ... les 2 feuilles sont identiques. Donc je peux détecter l'adresse d'une cellule contenant une MFC mais ... comment ... exactement ... la reproduire dans l'autre feuille Í la même adresse? Auriez-vous une suggestion? Merci Í l'avance.
Bonjour, Comme ceci : A )copier "TOUT" le contenu de la feuille dont on veut transférer les mises en forme conditionnelles vers une autre feuille vierge B ) Copier seulement les données de la feuille qui devait recevoir les mises en forme conditionnelles vers la nouvelle feuille. C ) Supprimer l'ancienne feuille D ) Renommer la nouvelle feuille avec le nom d'onglet de l'ancienne feuille. '---------------------------------------------- Sub test() Dim X As String 'Feuil1 est la feuille dont tu veux copier les mises 'en forme conditionnelles 'Débute par copier tout le contenu du la feuil1 vers 'une nouvelle feuille que l'on vient d'ajouter Worksheets("Feuil1").Copy before:=Sheets(Sheets.Count) 'Dans cette nouvelle feuille, on va copier seulement les 'données que contient la feuille4 ActiveSheet.UsedRange.Formula = Worksheets("Feuil4").UsedRange.Formula 'Supprime la feuill4 en prenant soin de conserver son nom d'onglet With Worksheets("Feuil4") X = .Name Application.DisplayAlerts = False .Delete End With ActiveSheet.Name = X End Sub '---------------------------------------------- MichD
Le 13/09/21 Í 13:11, rmill...@gmail.com a écrit :
Bonjour,
Je dois réussir Í soit copier ou Í reproduire ... que les mises en formes conditionnelles dans une même feuille mais dans 2 classeurs différents.
Mais ... sans ... les formats des cellules.
J'ai passé des heures Í chercher mais il semble y avoir une brèche Í ce niveau.
Au moment de le faire ... les 2 feuilles sont identiques. Donc je peux détecter l'adresse d'une cellule contenant une MFC mais ... comment ... exactement ... la reproduire dans l'autre feuille Í la même adresse?
Auriez-vous une suggestion?
Merci Í l'avance.
Bonjour,
Comme ceci :
A )copier "TOUT" le contenu de la feuille dont on veut transférer les
mises en forme conditionnelles vers une autre feuille vierge
B ) Copier seulement les données de la feuille qui devait recevoir les
mises en forme conditionnelles vers la nouvelle feuille.
C ) Supprimer l'ancienne feuille
D ) Renommer la nouvelle feuille avec le nom d'onglet de l'ancienne feuille.
'----------------------------------------------
Sub test()
Dim X As String
'Feuil1 est la feuille dont tu veux copier les mises
'en forme conditionnelles
'Débute par copier tout le contenu du la feuil1 vers
'une nouvelle feuille que l'on vient d'ajouter
Worksheets("Feuil1").Copy before:=Sheets(Sheets.Count)
'Dans cette nouvelle feuille, on va copier seulement les
'données que contient la feuille4
ActiveSheet.UsedRange.Formula = Worksheets("Feuil4").UsedRange.Formula
'Supprime la feuill4 en prenant soin de conserver son nom d'onglet
With Worksheets("Feuil4")
X = .Name
Application.DisplayAlerts = False
.Delete
End With
ActiveSheet.Name = X
End Sub
'----------------------------------------------
Bonjour, Je dois réussir Í soit copier ou Í reproduire ... que les mises en formes conditionnelles dans une même feuille mais dans 2 classeurs différents. Mais ... sans ... les formats des cellules. J'ai passé des heures Í chercher mais il semble y avoir une brèche Í ce niveau. Au moment de le faire ... les 2 feuilles sont identiques. Donc je peux détecter l'adresse d'une cellule contenant une MFC mais ... comment ... exactement ... la reproduire dans l'autre feuille Í la même adresse? Auriez-vous une suggestion? Merci Í l'avance.
Bonjour, Comme ceci : A )copier "TOUT" le contenu de la feuille dont on veut transférer les mises en forme conditionnelles vers une autre feuille vierge B ) Copier seulement les données de la feuille qui devait recevoir les mises en forme conditionnelles vers la nouvelle feuille. C ) Supprimer l'ancienne feuille D ) Renommer la nouvelle feuille avec le nom d'onglet de l'ancienne feuille. '---------------------------------------------- Sub test() Dim X As String 'Feuil1 est la feuille dont tu veux copier les mises 'en forme conditionnelles 'Débute par copier tout le contenu du la feuil1 vers 'une nouvelle feuille que l'on vient d'ajouter Worksheets("Feuil1").Copy before:=Sheets(Sheets.Count) 'Dans cette nouvelle feuille, on va copier seulement les 'données que contient la feuille4 ActiveSheet.UsedRange.Formula = Worksheets("Feuil4").UsedRange.Formula 'Supprime la feuill4 en prenant soin de conserver son nom d'onglet With Worksheets("Feuil4") X = .Name Application.DisplayAlerts = False .Delete End With ActiveSheet.Name = X End Sub '---------------------------------------------- MichD
rmill...
Merci. Je comprends. Mais je ne crois pas que je peux appliquer ceci. Je ne peux supprimer l'ancienne feuille. Car il y a beaucoup de nom définis. Aussi je dois conserver toutes les formules mais surtout les formats (sauf les conditionnels). À moins que j'ai mal compris?
Merci.
Je comprends. Mais je ne crois pas que je peux appliquer ceci. Je ne peux supprimer l'ancienne feuille. Car il y a beaucoup de nom définis. Aussi je dois conserver toutes les formules mais surtout les formats (sauf les conditionnels).
Merci. Je comprends. Mais je ne crois pas que je peux appliquer ceci. Je ne peux supprimer l'ancienne feuille. Car il y a beaucoup de nom définis. Aussi je dois conserver toutes les formules mais surtout les formats (sauf les conditionnels). À moins que j'ai mal compris?
MichD
Le 13/09/21 Í 16:43, a écrit :
Merci. Je comprends. Mais je ne crois pas que je peux appliquer ceci. Je ne peux supprimer l'ancienne feuille. Car il y a beaucoup de nom définis. Aussi je dois conserver toutes les formules mais surtout les formats (sauf les conditionnels). À moins que j'ai mal compris?
Et ceci : a) Tous les "NOMS" créés au niveau d'une feuille de calcul sont automatiquement recréés dans la nouvelle feuille lors de la copie. B) J'ai ajouté un peu de code prenant note des différents noms faisant partie de la "Feuil1" et la "Feuil4" que je place dans une variable tableau (array) et je les refais Í la fin. C ) Tu as 2 feuilles dans la procédure. Feuil1 : o͹ sont les mises Í copier dans la feuil4 Feuil4 : Nom de l'onglet o͹ seront les mises en forme conditionnelles de la feuil1. À toi de rebaptiser les feuilles de la procédure pour les noms des onglets des feuilles de ton environnement. Comme je n'ai pas vu le classeur, il se peut qu'il y ait des choses dont je n'ai pas envisagé la présence dans cette procédure. Tu devras l'ajouter! Il y a peut-être d'autres manières de procéder, mais je termine ce que j'ai commencé. Important : Teste ce qui suit avec une copie du fichier original. Dim T(), A As Long 'Variables déclarées en haut du module '---------------------------------------- Sub test() Dim X As String, F As String 'Feuil1 est la feuille dont tu veux copier les mises 'en forme conditionnelles 'Débute par copier tout le contenu du la feuil1 vers 'une nouvelle feuille que l'on vient d'ajouter With Worksheets("Feuil1") F = .Name .Copy before:=Sheets(Sheets.Count) End With 'Dans cette nouvelle feuille, on va copier seulement les 'données que contient la feuille4 ActiveSheet.UsedRange.Formula = Worksheets("Feuil4").UsedRange.Formula 'Supprime la feuill4 en prenant soin de conserver son nom d'onglet With Worksheets("Feuil4") X = .Name A = 0 LesNoms .Name LesNoms F Application.DisplayAlerts = False .Delete End With ActiveSheet.Name = X Ajout_Name T End Sub '---------------------------------------- Sub LesNoms(F As String) Dim N As Name, Elt As Variant For Each N In ThisWorkbook.Names If InStr(1, N.Name, "!", vbTextCompare) = 0 Then If InStr(1, N.RefersTo, F, vbTextCompare) > 0 Then A = A + 1 ReDim Preserve T(1 To A) T(A) = N.Name & " " & N.RefersTo ElseIf InStr(1, N.RefersTo, "!", vbTextCompare) = 0 Then A = A + 1 ReDim Preserve T(1 To A) T(A) = N.Name & " " & N.RefersTo End If End If Next End Sub '---------------------------------------- Sub Ajout_Name(T()) Dim Elt As Variant, B As String For Each Elt In T With ThisWorkbook.Names B = Split(Elt, " ")(0) .Item(B).Delete .Add B, RefersTo:=Split(Elt, " ")(1) End With Next End Sub '---------------------------------------- MichD
Le 13/09/21 Í 16:43, rmill...@gmail.com a écrit :
Merci.
Je comprends. Mais je ne crois pas que je peux appliquer ceci. Je ne peux supprimer l'ancienne feuille. Car il y a beaucoup de nom définis. Aussi je dois conserver toutes les formules mais surtout les formats (sauf les conditionnels).
À moins que j'ai mal compris?
Et ceci :
a) Tous les "NOMS" créés au niveau d'une feuille de calcul sont
automatiquement recréés dans la nouvelle feuille lors de la copie.
B) J'ai ajouté un peu de code prenant note des différents noms faisant
partie de la "Feuil1" et la "Feuil4" que je place dans une variable
tableau (array) et je les refais Í la fin.
C ) Tu as 2 feuilles dans la procédure.
Feuil1 : o͹ sont les mises Í copier dans la feuil4
Feuil4 : Nom de l'onglet o͹ seront les mises en forme conditionnelles de
la feuil1. À toi de rebaptiser les feuilles de la procédure pour les
noms des onglets des feuilles de ton environnement.
Comme je n'ai pas vu le classeur, il se peut qu'il y ait des choses dont
je n'ai pas envisagé la présence dans cette procédure. Tu devras l'ajouter!
Il y a peut-être d'autres manières de procéder, mais je termine ce que
j'ai commencé.
Important : Teste ce qui suit avec une copie du fichier original.
Dim T(), A As Long 'Variables déclarées en haut du module
'----------------------------------------
Sub test()
Dim X As String, F As String
'Feuil1 est la feuille dont tu veux copier les mises
'en forme conditionnelles
'Débute par copier tout le contenu du la feuil1 vers
'une nouvelle feuille que l'on vient d'ajouter
With Worksheets("Feuil1")
F = .Name
.Copy before:=Sheets(Sheets.Count)
End With
'Dans cette nouvelle feuille, on va copier seulement les
'données que contient la feuille4
ActiveSheet.UsedRange.Formula = Worksheets("Feuil4").UsedRange.Formula
'Supprime la feuill4 en prenant soin de conserver son nom d'onglet
With Worksheets("Feuil4")
X = .Name
A = 0
LesNoms .Name
LesNoms F
Application.DisplayAlerts = False
.Delete
End With
ActiveSheet.Name = X
Ajout_Name T
End Sub
'----------------------------------------
Sub LesNoms(F As String)
Dim N As Name, Elt As Variant
For Each N In ThisWorkbook.Names
If InStr(1, N.Name, "!", vbTextCompare) = 0 Then
If InStr(1, N.RefersTo, F, vbTextCompare) > 0 Then
A = A + 1
ReDim Preserve T(1 To A)
T(A) = N.Name & " " & N.RefersTo
ElseIf InStr(1, N.RefersTo, "!", vbTextCompare) = 0 Then
A = A + 1
ReDim Preserve T(1 To A)
T(A) = N.Name & " " & N.RefersTo
End If
End If
Next
End Sub
'----------------------------------------
Sub Ajout_Name(T())
Dim Elt As Variant, B As String
For Each Elt In T
With ThisWorkbook.Names
B = Split(Elt, " ")(0)
.Item(B).Delete
.Add B, RefersTo:=Split(Elt, " ")(1)
End With
Next
End Sub
'----------------------------------------
Merci. Je comprends. Mais je ne crois pas que je peux appliquer ceci. Je ne peux supprimer l'ancienne feuille. Car il y a beaucoup de nom définis. Aussi je dois conserver toutes les formules mais surtout les formats (sauf les conditionnels). À moins que j'ai mal compris?
Et ceci : a) Tous les "NOMS" créés au niveau d'une feuille de calcul sont automatiquement recréés dans la nouvelle feuille lors de la copie. B) J'ai ajouté un peu de code prenant note des différents noms faisant partie de la "Feuil1" et la "Feuil4" que je place dans une variable tableau (array) et je les refais Í la fin. C ) Tu as 2 feuilles dans la procédure. Feuil1 : o͹ sont les mises Í copier dans la feuil4 Feuil4 : Nom de l'onglet o͹ seront les mises en forme conditionnelles de la feuil1. À toi de rebaptiser les feuilles de la procédure pour les noms des onglets des feuilles de ton environnement. Comme je n'ai pas vu le classeur, il se peut qu'il y ait des choses dont je n'ai pas envisagé la présence dans cette procédure. Tu devras l'ajouter! Il y a peut-être d'autres manières de procéder, mais je termine ce que j'ai commencé. Important : Teste ce qui suit avec une copie du fichier original. Dim T(), A As Long 'Variables déclarées en haut du module '---------------------------------------- Sub test() Dim X As String, F As String 'Feuil1 est la feuille dont tu veux copier les mises 'en forme conditionnelles 'Débute par copier tout le contenu du la feuil1 vers 'une nouvelle feuille que l'on vient d'ajouter With Worksheets("Feuil1") F = .Name .Copy before:=Sheets(Sheets.Count) End With 'Dans cette nouvelle feuille, on va copier seulement les 'données que contient la feuille4 ActiveSheet.UsedRange.Formula = Worksheets("Feuil4").UsedRange.Formula 'Supprime la feuill4 en prenant soin de conserver son nom d'onglet With Worksheets("Feuil4") X = .Name A = 0 LesNoms .Name LesNoms F Application.DisplayAlerts = False .Delete End With ActiveSheet.Name = X Ajout_Name T End Sub '---------------------------------------- Sub LesNoms(F As String) Dim N As Name, Elt As Variant For Each N In ThisWorkbook.Names If InStr(1, N.Name, "!", vbTextCompare) = 0 Then If InStr(1, N.RefersTo, F, vbTextCompare) > 0 Then A = A + 1 ReDim Preserve T(1 To A) T(A) = N.Name & " " & N.RefersTo ElseIf InStr(1, N.RefersTo, "!", vbTextCompare) = 0 Then A = A + 1 ReDim Preserve T(1 To A) T(A) = N.Name & " " & N.RefersTo End If End If Next End Sub '---------------------------------------- Sub Ajout_Name(T()) Dim Elt As Variant, B As String For Each Elt In T With ThisWorkbook.Names B = Split(Elt, " ")(0) .Item(B).Delete .Add B, RefersTo:=Split(Elt, " ")(1) End With Next End Sub '---------------------------------------- MichD
rmill...
Merci encore. Je vais essayer et vous revenir, Mais il y a 2 questions que je me pose. L'autre feuille est dans un autre classeur. Donc je crois que cela va créer des liaisons. Et aussi ... OK pour le nom de la feuille ... mais ... j'ai une foule de lignes de codes qui fait référence Í la feuil12. Peut-on aussi renommer le sheetCodeName?
Merci encore. Je vais essayer et vous revenir,
Mais il y a 2 questions que je me pose. L'autre feuille est dans un autre classeur. Donc je crois que cela va créer des liaisons.
Et aussi ... OK pour le nom de la feuille ... mais ... j'ai une foule de lignes de codes qui fait référence Í la feuil12. Peut-on aussi renommer le sheetCodeName?
Merci encore. Je vais essayer et vous revenir, Mais il y a 2 questions que je me pose. L'autre feuille est dans un autre classeur. Donc je crois que cela va créer des liaisons. Et aussi ... OK pour le nom de la feuille ... mais ... j'ai une foule de lignes de codes qui fait référence Í la feuil12. Peut-on aussi renommer le sheetCodeName?
rmill...
Salut Í nouveau. Je crois être utile de préciser ceci. Car je ne crois pas ceci être géré par le code. - Les feuilles en question sont dans 2 classeurs distincts. - Les 2 feuilles sont nommées NOTES et sont Feuil12. - Mais ... dans un classeur ... par exemple ... pour cette feuille la police est en Calibri. - Et dans l'autre classeur ... pour la feuille la police est en Times New Roman. Alors j'ai besoin d'amener les MFC de la feuil12 du classeur1 (police Times New Roman) dans la feuil12 du classeur2 mais ... en conservant la police Calibri , le type de bordure, couleur ... bref tous les formats de la feuille du classeur2,
Salut Í nouveau. Je crois être utile de préciser ceci. Car je ne crois pas ceci être géré par le code.
- Les feuilles en question sont dans 2 classeurs distincts.
- Les 2 feuilles sont nommées NOTES et sont Feuil12.
- Mais ... dans un classeur ... par exemple ... pour cette feuille la police est en Calibri.
- Et dans l'autre classeur ... pour la feuille la police est en Times New Roman.
Alors j'ai besoin d'amener les MFC de la feuil12 du classeur1 (police Times New Roman) dans la feuil12 du classeur2 mais ... en conservant la police Calibri , le type de bordure, couleur ... bref tous les formats de la feuille du classeur2,
Salut Í nouveau. Je crois être utile de préciser ceci. Car je ne crois pas ceci être géré par le code. - Les feuilles en question sont dans 2 classeurs distincts. - Les 2 feuilles sont nommées NOTES et sont Feuil12. - Mais ... dans un classeur ... par exemple ... pour cette feuille la police est en Calibri. - Et dans l'autre classeur ... pour la feuille la police est en Times New Roman. Alors j'ai besoin d'amener les MFC de la feuil12 du classeur1 (police Times New Roman) dans la feuil12 du classeur2 mais ... en conservant la police Calibri , le type de bordure, couleur ... bref tous les formats de la feuille du classeur2,
MichD
Le 13/09/21 Í 22:48, a écrit :
Salut Í nouveau. Je crois être utile de préciser ceci. Car je ne crois pas ceci être géré par le code. - Les feuilles en question sont dans 2 classeurs distincts. - Les 2 feuilles sont nommées NOTES et sont Feuil12. - Mais ... dans un classeur ... par exemple ... pour cette feuille la police est en Calibri. - Et dans l'autre classeur ... pour la feuille la police est en Times New Roman. Alors j'ai besoin d'amener les MFC de la feuil12 du classeur1 (police Times New Roman) dans la feuil12 du classeur2 mais ... en conservant la police Calibri , le type de bordure, couleur ... bref tous les formats de la feuille du classeur2,
Il y a plus simple, comme ceci : "xlCellTypeAllFormatConditions" copie tout le format de la cellule et des mises en forme conditionnelles. Avant d'effectuer la copie, tu mets chaque élément du format que tu veux retrouver dans une variable, et tu la récupères après la copie. tu peux faire la même chose pour les bordures... pour être plus précis. '---------------------------------------------- Sub Test() Dim C As Range, Adr As String Dim S As String, P As String Application.ScreenUpdating = False With Worksheets("Feuil1") .Activate For Each C In ActiveCell.SpecialCells(xlCellTypeAllFormatConditions).Cells Adr = C.Address C.Copy With Worksheets("Feuil3").Range(Adr) S = .Font.Size P = .Font.Name End With C.Copy With Worksheets("Feuil3") With .Range(Adr) .PasteSpecial xlPasteAllMergingConditionalFormats .Font.Size = S .Font.Name = P 'Í toi de définir les caractéristiques de la bordure .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium, ColorIndex:=xlAutomatic End With End With Next End With Application.ScreenUpdating = True End Sub '---------------------------------------------- MichD
Le 13/09/21 Í 22:48, rmill...@gmail.com a écrit :
Salut Í nouveau. Je crois être utile de préciser ceci. Car je ne crois pas ceci être géré par le code.
- Les feuilles en question sont dans 2 classeurs distincts.
- Les 2 feuilles sont nommées NOTES et sont Feuil12.
- Mais ... dans un classeur ... par exemple ... pour cette feuille la police est en Calibri.
- Et dans l'autre classeur ... pour la feuille la police est en Times New Roman.
Alors j'ai besoin d'amener les MFC de la feuil12 du classeur1 (police Times New Roman) dans la feuil12 du classeur2 mais ... en conservant la police Calibri , le type de bordure, couleur ... bref tous les formats de la feuille du classeur2,
Il y a plus simple, comme ceci :
"xlCellTypeAllFormatConditions" copie tout le format de la cellule et
des mises en forme conditionnelles.
Avant d'effectuer la copie, tu mets chaque élément du format que tu veux
retrouver dans une variable, et tu la récupères après la copie.
tu peux faire la même chose pour les bordures... pour être plus précis.
'----------------------------------------------
Sub Test()
Dim C As Range, Adr As String
Dim S As String, P As String
Application.ScreenUpdating = False
With Worksheets("Feuil1")
.Activate
For Each C In
ActiveCell.SpecialCells(xlCellTypeAllFormatConditions).Cells
Adr = C.Address
C.Copy
With Worksheets("Feuil3").Range(Adr)
S = .Font.Size
P = .Font.Name
End With
C.Copy
With Worksheets("Feuil3")
With .Range(Adr)
.PasteSpecial xlPasteAllMergingConditionalFormats
.Font.Size = S
.Font.Name = P
'Í toi de définir les caractéristiques de la bordure
.BorderAround LineStyle:=xlContinuous,
Weight:=xlMedium, ColorIndex:=xlAutomatic
End With
End With
Next
End With
Application.ScreenUpdating = True
End Sub
'----------------------------------------------
Salut Í nouveau. Je crois être utile de préciser ceci. Car je ne crois pas ceci être géré par le code. - Les feuilles en question sont dans 2 classeurs distincts. - Les 2 feuilles sont nommées NOTES et sont Feuil12. - Mais ... dans un classeur ... par exemple ... pour cette feuille la police est en Calibri. - Et dans l'autre classeur ... pour la feuille la police est en Times New Roman. Alors j'ai besoin d'amener les MFC de la feuil12 du classeur1 (police Times New Roman) dans la feuil12 du classeur2 mais ... en conservant la police Calibri , le type de bordure, couleur ... bref tous les formats de la feuille du classeur2,
Il y a plus simple, comme ceci : "xlCellTypeAllFormatConditions" copie tout le format de la cellule et des mises en forme conditionnelles. Avant d'effectuer la copie, tu mets chaque élément du format que tu veux retrouver dans une variable, et tu la récupères après la copie. tu peux faire la même chose pour les bordures... pour être plus précis. '---------------------------------------------- Sub Test() Dim C As Range, Adr As String Dim S As String, P As String Application.ScreenUpdating = False With Worksheets("Feuil1") .Activate For Each C In ActiveCell.SpecialCells(xlCellTypeAllFormatConditions).Cells Adr = C.Address C.Copy With Worksheets("Feuil3").Range(Adr) S = .Font.Size P = .Font.Name End With C.Copy With Worksheets("Feuil3") With .Range(Adr) .PasteSpecial xlPasteAllMergingConditionalFormats .Font.Size = S .Font.Name = P 'Í toi de définir les caractéristiques de la bordure .BorderAround LineStyle:=xlContinuous, Weight:=xlMedium, ColorIndex:=xlAutomatic End With End With Next End With Application.ScreenUpdating = True End Sub '---------------------------------------------- MichD
rmill...
Super. Un grand merci. Je travaille sur ceci et je vous reviens.
Super. Un grand merci. Je travaille sur ceci et je vous reviens.
MichD
Le 14/09/21 Í 07:30, a écrit :
Super. Un grand merci. Je travaille sur ceci et je vous reviens.
Seulement 2 variables Í définir : '------------------------------------------ Sub Test() Dim C As Range, Adr As String Dim S As String, P As String Dim G As Boolean, iT As Boolean Dim St As Double, W As Double, Col As Long Dim FeuilleSource As String, J As Long Dim H As Long, M As Long, V As Variant Dim FeuilleDest As String '************Variables Í définir****************** FeuilleSource = "Feuil1" 'Nom onglet feuille o͹ sont les mises 'en forme conditionnelles Í copier FeuilleDest = "Feuil3" 'Nom onglet o͹ seront copiées les 'mises en forme conditionnelles '***************************************************** Application.ScreenUpdating = False With Worksheets(FeuilleSource) For Each C In .UsedRange.SpecialCells(xlCellTypeAllFormatConditions).Cells Adr = C.Address Application.CutCopyMode = False With Worksheets(FeuilleDest).Range(Adr) V = .Formula S = .Font.Size P = .Font.Name G = .Font.Bold J = .Font.Color H = .Interior.Color iT = .Font.Italic With .Borders(xlEdgeLeft) St = .LineStyle Col = .ColorIndex W = .Weight End With End With C.Copy With Worksheets(FeuilleDest) With .Range(Adr) .PasteSpecial xlPasteAllMergingConditionalFormats .Formula = V .Font.Size = S .Font.Name = P .Font.Bold = G .Font.Italic = iT .Font.Color = J .Interior.Color = H For M = 7 To 10 With .Borders(M) .LineStyle = St If .LineStyle = -4142 Then .LineStyle = St .ColorIndex = Col .Weight = W End If End With Next End With End With Next End With Application.ScreenUpdating = True End Sub '------------------------------------------ MichD
Le 14/09/21 Í 07:30, rmill...@gmail.com a écrit :
Super. Un grand merci.
Je travaille sur ceci et je vous reviens.
Seulement 2 variables Í définir :
'------------------------------------------
Sub Test()
Dim C As Range, Adr As String
Dim S As String, P As String
Dim G As Boolean, iT As Boolean
Dim St As Double, W As Double, Col As Long
Dim FeuilleSource As String, J As Long
Dim H As Long, M As Long, V As Variant
Dim FeuilleDest As String
'************Variables Í définir******************
FeuilleSource = "Feuil1" 'Nom onglet feuille o͹ sont les mises
'en forme conditionnelles Í copier
FeuilleDest = "Feuil3" 'Nom onglet o͹ seront copiées les
'mises en forme conditionnelles
'*****************************************************
Application.ScreenUpdating = False
With Worksheets(FeuilleSource)
For Each C In
.UsedRange.SpecialCells(xlCellTypeAllFormatConditions).Cells
Adr = C.Address
Application.CutCopyMode = False
With Worksheets(FeuilleDest).Range(Adr)
V = .Formula
S = .Font.Size
P = .Font.Name
G = .Font.Bold
J = .Font.Color
H = .Interior.Color
iT = .Font.Italic
With .Borders(xlEdgeLeft)
St = .LineStyle
Col = .ColorIndex
W = .Weight
End With
End With
C.Copy
With Worksheets(FeuilleDest)
With .Range(Adr)
.PasteSpecial xlPasteAllMergingConditionalFormats
.Formula = V
.Font.Size = S
.Font.Name = P
.Font.Bold = G
.Font.Italic = iT
.Font.Color = J
.Interior.Color = H
For M = 7 To 10
With .Borders(M)
.LineStyle = St
If .LineStyle = -4142 Then
.LineStyle = St
.ColorIndex = Col
.Weight = W
End If
End With
Next
End With
End With
Next
End With
Application.ScreenUpdating = True
End Sub
'------------------------------------------
Super. Un grand merci. Je travaille sur ceci et je vous reviens.
Seulement 2 variables Í définir : '------------------------------------------ Sub Test() Dim C As Range, Adr As String Dim S As String, P As String Dim G As Boolean, iT As Boolean Dim St As Double, W As Double, Col As Long Dim FeuilleSource As String, J As Long Dim H As Long, M As Long, V As Variant Dim FeuilleDest As String '************Variables Í définir****************** FeuilleSource = "Feuil1" 'Nom onglet feuille o͹ sont les mises 'en forme conditionnelles Í copier FeuilleDest = "Feuil3" 'Nom onglet o͹ seront copiées les 'mises en forme conditionnelles '***************************************************** Application.ScreenUpdating = False With Worksheets(FeuilleSource) For Each C In .UsedRange.SpecialCells(xlCellTypeAllFormatConditions).Cells Adr = C.Address Application.CutCopyMode = False With Worksheets(FeuilleDest).Range(Adr) V = .Formula S = .Font.Size P = .Font.Name G = .Font.Bold J = .Font.Color H = .Interior.Color iT = .Font.Italic With .Borders(xlEdgeLeft) St = .LineStyle Col = .ColorIndex W = .Weight End With End With C.Copy With Worksheets(FeuilleDest) With .Range(Adr) .PasteSpecial xlPasteAllMergingConditionalFormats .Formula = V .Font.Size = S .Font.Name = P .Font.Bold = G .Font.Italic = iT .Font.Color = J .Interior.Color = H For M = 7 To 10 With .Borders(M) .LineStyle = St If .LineStyle = -4142 Then .LineStyle = St .ColorIndex = Col .Weight = W End If End With Next End With End With Next End With Application.ScreenUpdating = True End Sub '------------------------------------------ MichD
rmill...
Bonjour Í nouveau, J'éprouve un peu de difficulté mais j'avance. Sauriez-vous me préciser la différence entre .PasteSpecial xlPasteFormats et .PasteSpecial xlPasteAllMergingConditionalFormats Car j'ai cherché sans succès. Y a t'il une différences?
Bonjour Í nouveau,
J'éprouve un peu de difficulté mais j'avance.
Sauriez-vous me préciser la différence entre .PasteSpecial xlPasteFormats et .PasteSpecial xlPasteAllMergingConditionalFormats
Car j'ai cherché sans succès. Y a t'il une différences?
Bonjour Í nouveau, J'éprouve un peu de difficulté mais j'avance. Sauriez-vous me préciser la différence entre .PasteSpecial xlPasteFormats et .PasteSpecial xlPasteAllMergingConditionalFormats Car j'ai cherché sans succès. Y a t'il une différences?
rmill...
Bonjour, J'ai adapté votre code suggéré Í ma situation et cela fonctionne. Je vous remercie grandement. Car cela me semblait pas possible Í un certain moment. J'ai vraiment cherché longtemps. J'ai vu que plusieurs au fil des ans ont aussi eu de la difficulté avec ceci. Encore merci.
Bonjour,
J'ai adapté votre code suggéré Í ma situation et cela fonctionne. Je vous remercie grandement.
Car cela me semblait pas possible Í un certain moment. J'ai vraiment cherché longtemps.
J'ai vu que plusieurs au fil des ans ont aussi eu de la difficulté avec ceci.
Bonjour, J'ai adapté votre code suggéré Í ma situation et cela fonctionne. Je vous remercie grandement. Car cela me semblait pas possible Í un certain moment. J'ai vraiment cherché longtemps. J'ai vu que plusieurs au fil des ans ont aussi eu de la difficulté avec ceci. Encore merci.