Recopie de la couleur et/ou police d'une ligne

Le 20/02/2013 à 05:10

Bonjour à tous,

Je débute sur VBA, et j'ai pu adapter une macro prise sur le site à mon classeur xls, mais voilà je bloque sur un problème.

J'arrive à recopie les lignes de tous mes onglets vers l'onglet 'main courante', jusqu'à là tout va bien.

Maintenant je voudrais recopier également la couleur et/ou la police de la ligne que j'aurai choisi au préalable vers la "main courante"

Je cherche désespérément depuis quelques jours, si quelqu'un peut m'aider.

Merci d'avance

Option Explicit

Private Sub CommandButton1_Click()

'Declaration des vaiables

Dim nomonglet(19) As String 'Declaration d'un tableau chaine de caractere de 7 dimensions (0->6)

Dim myworksheet_IN As Worksheet

Dim myworksheet_OUT As Worksheet

Dim tache1 As String 'Adresse ou se trouve le titre T‰che1

Dim mydate1 As String 'Adresse ou se trouve la date

Dim tempdate As String

Dim I, b, numline As Double

Dim ligne_debut_planning As String 'Adresse a partir de laquelle on doit ecrire les donnŽes dans onglets planning

'Definition des noms onglets et des postions des valeurs

nomonglet(0) = "9720101"

nomonglet(1) = "9720201"

nomonglet(2) = "9720401"

nomonglet(3) = "9720501"

nomonglet(4) = "9720801"

nomonglet(5) = "9720901"

nomonglet(6) = "9721101"

nomonglet(7) = "9721201"

nomonglet(8) = "9721301"

nomonglet(9) = "9721501"

nomonglet(10) = "9721701"

nomonglet(11) = "9721901"

nomonglet(12) = "9721902"

nomonglet(13) = "9722401"

nomonglet(14) = "9722801"

nomonglet(15) = "9722901"

nomonglet(16) = "9723001"

nomonglet(17) = "9723301"

nomonglet(18) = "9723401"

nomonglet(19) = "9723402"

'Dans ces onglets on dŽfinit les adresses o se trouve les valeurs que l'on veut recuperer

'Il faut que se soit le mme endroit pour tous les onglets

tache1 = "$C$2"

mydate1 = "$D$1"

ligne_debut_planning = "$a$4"

'On dŽfinit dans quel onglet on va mettre la synthese de planning

Set myworksheet_IN = ActiveWorkbook.Worksheets("Main courante")

'On efface les anciennes lignes du planning

myworksheet_IN.Range(ligne_debut_planning, "F65536").Clear

'On effectue une boucle afin de parcourir tout ces onglets et reporter les valeurs dans l'onglet Index

For I = LBound(nomonglet) To UBound(nomonglet) ' Pour tous les onlgets

Set myworksheet_OUT = ActiveWorkbook.Worksheets(nomonglet(I)) 'On ouvre l'onglets

b = 1

While myworksheet_OUT.Range(tache1).Offset(b, 0) <> "" 'Tant que la cellule est vide on boucle

tempdate = Format(myworksheet_OUT.Range(mydate1).Value, "")

myworksheet_IN.Range(ligne_debut_planning).Offset(numline, 0).Value = myworksheet_OUT.Range(tache1).Offset(b, 0).Value

myworksheet_IN.Range(ligne_debut_planning).Offset(numline, 1).NumberFormat = ""

myworksheet_IN.Range(ligne_debut_planning).Offset(numline, 1).Value = Format(tempdate, "")

myworksheet_IN.Range(ligne_debut_planning).Offset(numline, 2).Value = myworksheet_OUT.Range(tache1).Offset(b, 1).Value

myworksheet_IN.Range(ligne_debut_planning).Offset(numline, 2).NumberFormat = ""

myworksheet_IN.Range(ligne_debut_planning).Offset(numline, 3).Value = myworksheet_OUT.Range(tache1).Offset(b, 2).Value

myworksheet_IN.Range(ligne_debut_planning).Offset(numline, 3).NumberFormat = ""

myworksheet_IN.Range(ligne_debut_planning).Offset(numline, 4).Value = myworksheet_OUT.Range(tache1).Offset(b, 3).Value

myworksheet_IN.Range(ligne_debut_planning).Offset(numline, 4).NumberFormat = ""

myworksheet_IN.Range(ligne_debut_planning).Offset(numline, 5).Value = myworksheet_OUT.Range(tache1).Offset(b, 4).Value

myworksheet_IN.Range(ligne_debut_planning).Offset(numline, 5).NumberFormat = "DD/MM/YYYY"

myworksheet_IN.Range(ligne_debut_planning).Offset(numline, 6).Value = myworksheet_OUT.Range(tache1).Offset(b, 5).Value

myworksheet_IN.Range(ligne_debut_planning).Offset(numline, 6).NumberFormat = "DD/MM/YYYY"

myworksheet_IN.Range(ligne_debut_planning).Offset(numline, 7).Value = myworksheet_OUT.Range(tache1).Offset(b, 6).Value

myworksheet_IN.Range(ligne_debut_planning).Offset(numline, 7).NumberFormat = "DD/MM/YYYY"

numline = numline + 1

b = b + 1

Wend

Next

Range("A1:Z100").Select

Columns("C").WrapText = True

Rows("1:100").EntireRow.AutoFit

With Selection.Font

ActiveWindow.SmallScroll Down:=-1000

Range("A1:G1000").Select

With Selection

.HorizontalAlignment = xlGeneral

.VerticalAlignment = xlCenter

.WrapText = True

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

.WrapText = True

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Range("A1").Select

ActiveWindow.zoom = 80

.Name = "Arial"

.Size = 12

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = 1

.TintAndShade = 0

.ThemeFont = xlThemeFontNone

End With

With Selection.Font

.Name = "Arial"

.Size = 12

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = 1

.TintAndShade = 0

.ThemeFont = xlThemeFontNone

End With

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

.WrapText = True

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

End Sub

Le 20/02/2013 à 10:30

Bonjour

Un fichier avec cette macro en expliquant ce que tu veux faire serait préférable

Le 20/02/2013 à 18:33

Bonjour à tous,

Merci Banzai64, j'ai pu alléger mon fichier, dans le classeur j'ai 3 onglets:

Main courante, 9720101, 9720201.

J'arrive à copier la ligne 3 des 2 onglets 9720101 et 9720201 vers l'onglet main courante, mais comment récupérer la couleur de remplissage et la couleur de la police.

Comment puis-je compléter ma macro ?

Merci pour votre aide

Christian

21classeur1.xlsm (56.04 Ko)
Le 20/02/2013 à 19:05

Bonjour

D'où viennent les informations "Classeur 1" et "Classeur 2" ?

A tester

21chris2807-recopie-v001.xlsm (56.90 Ko)
Le 20/02/2013 à 19:44

Bonjour Banzai64

C'est exactement çà que je voulais, je te remercie pour ton aide et la rapidité de ta réponse.

J'ai pu adapter l'exemple à mon classeur.

Les infos des onglets 9720101 et 9720201 sont rentrées manuellement.

J'ai encore besoin d'aide, je souhaiterais reporter le nom du classeur (qui est en fait le nom du site dans l'onglet main courante en colonne B) avec la ligne copiée.

Comment je peux faire?

Le 20/02/2013 à 20:52

Bonsoir

Tu n'as pas répondu

Banzai64 a écrit :

D'où viennent les informations "Classeur 1" et "Classeur 2" ?

Dans ton classeur où trouve t-on ces informations ?

Le 20/02/2013 à 21:17

J'ai modifié le classeur pour mieux comprendre.

En effet classeur 1 et classeur 2 sont des 'sites', colonne B de la main courante

Christian

22chris2807-recopie-v001.xlsm (57.59 Ko)
Le 20/02/2013 à 21:32

Bonsoir

Ton fichier ne m'avance guère

Où prends tu ces noms ?

Il sont rentés à la main et il ne faut pas les effacer ?

Comment veux-tu que la macro inscrive ces noms si on ne sait d'où ils proviennent

Le 20/02/2013 à 22:31

Où prends tu ces noms ? CES NOMS SONT INSCRITS EN DEFINITIFS SUR LES ONGLETS

EN D1

Il sont rentés à la main et il ne faut pas les effacer CHAQUE SITE A SON ONGLET

LES LIGNES SONT INCREMENTEES AU FUR ET A MESURE DANS L ONGLET MAIN COURANTE

COPIE EN COLONNE A DE LA MAIN COURANTE -> ok/nok CELLULE C3 DE L ONGLET X

COPIE EN COLONNE B DE LA MAIN COURANTE-> LE SITE CELLULE D1 DE L ONGLET X

COPIE EN COLONNE C DE LA MAIN COURANTE -> COMMENTAIRES CELLULE D3 DE L ONGLET X

Comment veux-tu que la macro inscrive ces noms si on ne sait d'où ils proviennent

Le 20/02/2013 à 22:51

Bonjour

Désolé mais je ne voyais pas

A tester

16chris2807-recopie-v003.xlsm (58.47 Ko)
Le 20/02/2013 à 23:28

C est exactement ca

on peut mettre STP la couleur de remplissage et le format de la police egalement en colonne B pour avoir une ligne copiee complete au meme format

merci

Le 20/02/2013 à 23:38

Bonsoir

A tester

18chris2807-recopie-v004.xlsm (57.61 Ko)
Le 21/02/2013 à 02:28

Superbe, encore merci pour ton aide

Christian

Rechercher des sujets similaires à "recopie couleur police ligne"