IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

rapatriement format cellule [XL-2013]


Sujet :

Macros et VBA Excel

  1. #1
    Membre averti
    Homme Profil pro
    ingénieur microbiologiste
    Inscrit en
    Mai 2020
    Messages
    17
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Vienne (Poitou Charente)

    Informations professionnelles :
    Activité : ingénieur microbiologiste
    Secteur : Industrie

    Informations forums :
    Inscription : Mai 2020
    Messages : 17
    Par défaut rapatriement format cellule
    Bonjour,

    J'ai cette macro qui fonctionne bien.
    Elle me permet de récupérer des lignes d'un tableau dans l'onglet "Source" avec la date de l'année en cours et de les mettre dans l'onglet "Tr2".
    Le seul soucis c'est que certaines cellules ont des formats spécifiques que j'aimerai également rapatrié, mais je n'arrive pas à le faire.
    Quelqu'un pourrait m'aider svp?
    Merci d'avance !

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    Sub A_graph()
     
    Dim CS As Workbook, CD As Workbook 'déclare les variables CS (Classeur Source) et CD (Classeur Destination)
    Dim OS As Worksheet, Tr2 As Worksheet 'déclare les variable OS (Onglet Source) et Tr2 (Onglet Destination)
     
    Set CD = ThisWorkbook 'définit le classeur destination CD
    Set OS = CD.Worksheets("Source") 'définit l'onglet source OS
    Set Tr2 = CD.Worksheets("Tr2") 'définit l'onglet destination OD
     
    Tr2.Select
    Tr2.Range("A2:Z400").Clear 'efface d'éventuelles anciennes données
    TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
     
    For I = 4 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la quatrieme)
        A = Year(TV(I, 1)) 'définit l'année A de la donnée ligne I colonne 1 de TV
        If A = Year(Date) Then   'condition : si l'année A correspond à la valeur de A1
            LI = Cells(Application.Rows.Count, "A").End(xlUp).Row + 1 'définit la ligne LI (première ligne vide de la colonne A)
            Cells(LI, "A") = TV(I, 1) 
            Cells(LI, "B") = TV(I, 38) 
            Cells(LI, "C") = TV(I, 41) 
            Cells(LI, "D") = TV(I, 73) 
            Cells(LI, "E") = TV(I, 76) 
        End If 'fin de la condition
    Next I 'prochaine ligne de a boucle
     
    End Sub

  2. #2
    Membre émérite
    Homme Profil pro
    ingénieur d'étude
    Inscrit en
    Juin 2013
    Messages
    563
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : ingénieur d'étude
    Secteur : Industrie

    Informations forums :
    Inscription : Juin 2013
    Messages : 563
    Par défaut
    Bonjour,

    Le plus simple est de passer par une copie. L'exportation de format d'une cellule à l'autre sans passer par le presse-papier est en effet pénible.
    Vous pourriez par exemple créer une Sub dédiée à la copie :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    Sub CopyCellWithFormat(Src as Range, Dest as Range)
        Src.Copy
        Dest.PasteSpecial xlPasteValues
        Dest.PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
    End Sub
    Il est ensuite aisé de modifier votre précédent code :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    Sub A_graph()
     
    Dim CS As Workbook, CD As Workbook 'déclare les variables CS (Classeur Source) et CD (Classeur Destination)
    Dim OS As Worksheet, Tr2 As Worksheet 'déclare les variable OS (Onglet Source) et Tr2 (Onglet Destination)
     
    Set CD = ThisWorkbook 'définit le classeur destination CD
    Set OS = CD.Worksheets("Source") 'définit l'onglet source OS
    Set Tr2 = CD.Worksheets("Tr2") 'définit l'onglet destination OD
     
    Tr2.Select
    Tr2.Range("A2:Z400").Clear 'efface d'éventuelles anciennes données
    TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
     
    For I = 4 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la quatrieme)
        A = Year(TV(I, 1)) 'définit l'année A de la donnée ligne I colonne 1 de TV
        If A = Year(Date) Then   'condition : si l'année A correspond à la valeur de A1
            LI = Cells(Application.Rows.Count, "A").End(xlUp).Row + 1 'définit la ligne LI (première ligne vide de la colonne A)
            CopyCellWithFormat TV(I, 1), Cells(LI, "A")
            CopyCellWithFormat TV(I, 38), Cells(LI, "B")
            CopyCellWithFormat TV(I, 41), Cells(LI, "C")
            CopyCellWithFormat TV(I, 73), Cells(LI, "D")
            CopyCellWithFormat TV(I, 76), Cells(LI, "E")
        End If 'fin de la condition
    Next I 'prochaine ligne de a boucle
     
    End Sub
    Notez que le test :
    ne vérifie pas si l'année A est identique à celle de la cellule A1. Il vérifie plutôt que l'année A est identique à l'année en cours.

    Cdt

  3. #3
    Membre averti
    Homme Profil pro
    ingénieur microbiologiste
    Inscrit en
    Mai 2020
    Messages
    17
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Vienne (Poitou Charente)

    Informations professionnelles :
    Activité : ingénieur microbiologiste
    Secteur : Industrie

    Informations forums :
    Inscription : Mai 2020
    Messages : 17
    Par défaut
    Bonjour ,
    Merci de votre réponse rapide.
    Pour le test :
    J'ai oublié de modifier le commentaire correspondant... Mais c'est bien ce test que je souhaite.

    En ce qui concerne votre solution, j'ai un message d'erreur qui me dit :

    Nom : Sans titre.png
Affichages : 144
Taille : 35,2 Ko

    Le TV de la première ligne de ma boucle se sélectionne également tout seul.

  4. #4
    Membre émérite
    Homme Profil pro
    ingénieur d'étude
    Inscrit en
    Juin 2013
    Messages
    563
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Paris (Île de France)

    Informations professionnelles :
    Activité : ingénieur d'étude
    Secteur : Industrie

    Informations forums :
    Inscription : Juin 2013
    Messages : 563
    Par défaut
    Arfff...

    Un problème de type de données.
    La variable TV était de type 'Variant', ce qui posait problème.
    En la redéfinissant en tant que 'Range', le problème devrait être résolu :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    Sub A_graph()
     
        Dim CS As Workbook, CD As Workbook 'déclare les variables CS (Classeur Source) et CD (Classeur Destination)
        Dim OS As Worksheet, Tr2 As Worksheet 'déclare les variable OS (Onglet Source) et Tr2 (Onglet Destination)
        Dim I As Long, A As Long, LI As Long, TV As Range
         
        Set OS = ThisWorkbook.Worksheets(1)
        Set Tr2 = ThisWorkbook.Worksheets(2)
         
        Tr2.Select
        Tr2.Range("A2:Z400").Clear 'efface d'éventuelles anciennes données
        Set TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
         
        For I = 4 To TV.Rows.Count 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la quatrieme)
            A = Year(TV(I, 1)) 'définit l'année A de la donnée ligne I colonne 1 de TV
            If A = Year(Date) Then   'condition : si l'année A correspond à la valeur de A1
                LI = Cells(Application.Rows.Count, "A").End(xlUp).Row + 1 'définit la ligne LI (première ligne vide de la colonne A)
                CopyCellWithFormat TV(I, 1), Cells(LI, "A")
                CopyCellWithFormat TV(I, 38), Cells(LI, "B")
                CopyCellWithFormat TV(I, 41), Cells(LI, "C")
                CopyCellWithFormat TV(I, 73), Cells(LI, "D")
                CopyCellWithFormat TV(I, 76), Cells(LI, "E")
            End If 'fin de la condition
        Next I 'prochaine ligne de a boucle
     
    End Sub
    Cdt

  5. #5
    Membre averti
    Homme Profil pro
    ingénieur microbiologiste
    Inscrit en
    Mai 2020
    Messages
    17
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Vienne (Poitou Charente)

    Informations professionnelles :
    Activité : ingénieur microbiologiste
    Secteur : Industrie

    Informations forums :
    Inscription : Mai 2020
    Messages : 17
    Par défaut
    Merci de votre aide, ça fonctionne très bien !

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Caractère obligatoire dans format cellule
    Par LEIRIA dans le forum Excel
    Réponses: 8
    Dernier message: 06/06/2007, 11h21
  2. format cellule (text) rapatrier par base access
    Par makroute dans le forum Excel
    Réponses: 2
    Dernier message: 23/05/2007, 12h21
  3. [VBA-E]automatiser "clic droit, format cellule, texte"
    Par jmlcea dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 21/04/2006, 17h21
  4. [VBA-E] Format cellule
    Par peon3 dans le forum Macros et VBA Excel
    Réponses: 6
    Dernier message: 05/02/2006, 19h35
  5. [Delphi 2005] Format cellules Excel
    Par Vulcanos dans le forum API, COM et SDKs
    Réponses: 2
    Dernier message: 24/05/2005, 23h21

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo