Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

extraction d'une cellule de feuil1 et la mettre dans une cellule de feuil2

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
N

nsqualli

XLDnaute Junior
Bonjour tout le monde,

j'ai la tache de faire une macro qui permetra d'extraire les valeurs d'une cellule de feuil1 et la mettre dans une cellule de la feuille "liste demande".

voila le code que j'ai fais:

Code: 
Sub testCreation()

Const DistAG2AJ As Long = 3
Const DistAG2B As Long = -31

Dim cellule As Range


Sheets.Add
ActiveSheet.Name = "Liste des Demandes"

Call ecrire

For Each cellule In Range("AG1:AG" & Range("AG65000").End(xlUp).Row)

    If cellule.Value < cellule.Offset(0, DistAG2AJ) Then
    
        [COLOR="Red"]cellule.Offset(0, DistAG2B).Font.Color = vbGreen[/COLOR]
        
        
    End If
    
Next

End Sub

Cette partie de code, créee la feuille ("liste demande") par un appel a une autre procedure, apres elle passe a un traitement sur deux colonnes, si la valeur de la cellule de la colonne AJ est superieur a la valeur de la colonne AG de la meme ligne il colore la valeur de la cellule B, mais cela c'etait juste pour tester si la creation marche,
là j'ai besoin d'extraire la valeur de la cellule A, B, F, I, AG, AJ où le teste est vrai, et les mettre dans la nouvelle feuille ("liste demande")

aidez moi svp.
merci
 
Trier par date Trier par votes
Re : extraction d'une cellule de feuil1 et la mettre dans une cellule de feuil2

Salut,

Tu peux essayer ce code
Code: 
Sub Extraction()
  Dim DerLig As Long, Lig As Long
  Dim ShtD As Worksheet, DerLD As Long
  
  Sheets.Add
  ActiveSheet.Name = "Liste des Demandes"
  ' Définir la valeur de l'Objet ShtD
  ' Nom de la feuille de Destination
  Set ShtD = ActiveSheet
  
  Call ecrire
  
  ' Avec la Feuille 1
  With Sheets("Feuil1")
    ' Trouver la dernière ligne
    DerLig = .Range("AG" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
    For Lig = 1 To DerLig
      ' Si le test est OK
      If .Range("AG" & Lig) < .Range("AJ" & Lig) Then
        .Range("B" & Lig).Font.Color = vbGreen
        ' Extraire les valeurs des colonnes
        'A, B, F, I, AG, AJ où le teste est vrai
        ' Récupérer la dernière ligne de la feuille de destination
        DerLD = ShtD.Range("A" & Rows.Count).End(xlUp).Row
        ' Inscrire les valeurs
        ShtD.Range("A" & DerLD + 1).Value = .Range("A" & Lig).Value
        ShtD.Range("B" & DerLD + 1).Value = .Range("B" & Lig).Value
        ShtD.Range("F" & DerLD + 1).Value = .Range("F" & Lig).Value
        ShtD.Range("I" & DerLD + 1).Value = .Range("I" & Lig).Value
        ShtD.Range("AG" & DerLD + 1).Value = .Range("AG" & Lig).Value
        ShtD.Range("AJ" & DerLD + 1).Value = .Range("AJ" & Lig).Value
      End If
    Next Lig
  End With
End Sub

Je préfère utiliser des variables pour les lignes plutôt que l'utilisation d'Offset (plus facile à lire)

A+
 
Vote positif 0 Vote négatif
Re : extraction d'une cellule de feuil1 et la mettre dans une cellule de feuil2

Merci bcp, ça marche tes bien sauf que pour plus de lisibilité j'aimerai bien que les libelés soient en bold, comment je peux le faire?
 
Vote positif 0 Vote négatif
Re : extraction d'une cellule de feuil1 et la mettre dans une cellule de feuil2

Bon le probleme est résolu, et voila le code si ça peut aider:

ce code sert à ajouter une feuille, faire un teste sur deux colonnes, extraire les colonne vouloues des lignes où le teste est valide, et les insere dans la nouvelle feuille

Code: 
Sub Extraction()
  Dim DerLig As Long, Lig As Long
  Dim FeuilDst As Worksheet, DerLD As Long
  
  Sheets.Add
  ActiveSheet.Name = "Liste des Demandes"
  
  ' Définir la valeur de l'Objet FeuilDst
  ' Nom de la feuille de Destination
  Set FeuilDst = ActiveSheet
  
  Call ecrire
  
  ' Avec la Feuille 1
  With Sheets("Feuil1")
    
    ' Trouver la dernière ligne
    DerLig = .Range("AG" & Rows.Count).End(xlUp).Row
    
    ' Pour chaque ligne
    For Lig = 3 To DerLig
      
      ' Si le test est OK
      If .Range("AG" & Lig) < .Range("AJ" & Lig) Then
      
        'Colorer le numero en vert
        .Range("B" & Lig).Font.Color = vbGreen
        
        ' Extraire les valeurs des colonnes
        'A, B, F, I, AG, AJ où le teste est vrai
        ' Récupérer la dernière ligne de la feuille de destination
        DerLD = FeuilDst.Range("A" & Rows.Count).End(xlUp).Row
        
        ' Inscrire les valeurs
        FeuilDst.Range("A" & DerLD + 1).Value = .Range("A" & Lig).Value
        FeuilDst.Range("B" & DerLD + 1).Value = .Range("B" & Lig).Value
        FeuilDst.Range("C" & DerLD + 1).Value = .Range("F" & Lig).Value
        FeuilDst.Range("D" & DerLD + 1).Value = .Range("I" & Lig).Value
        FeuilDst.Range("E" & DerLD + 1).Value = .Range("AG" & Lig).Value
        FeuilDst.Range("F" & DerLD + 1).Value = .Range("AJ" & Lig).Value
        
      End If
      
    Next Lig
    
  End With
  
End Sub

code de sub ecrire() qui met en forme la nouvelle feuille:

Code: 
Sub ecrire()
'
' ecrire Macro
' Macro enregistrée le 14/11/2008 par elhoumy
'

'
    Range("A1").Select
    Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = "Réf"
    
    Range("B1").Select
    Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = "Numéro"
    
    Range("C1").Select
    Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = "Version Réelle"
    
    Range("D1").Select
    Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = "Type"
    
    Range("E1").Select
    Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = "Devis de Développement"
    
    Range("F1").Select
    Selection.Font.Bold = True
    ActiveCell.FormulaR1C1 = "RAF dev + tu"
    
    Range("A2").Select
    Columns("F:F").ColumnWidth = 17.86
End Sub

Bon courage
 
Vote positif 0 Vote négatif
Re : extraction d'une cellule de feuil1 et la mettre dans une cellule de feuil2

bon là j'ai envie que l'insertion apres l'extraction de la premiere feuille, se fasse dans une une feuille deja existante qui porte le nom "Demandes closes".
comment je peux faire svp?
 
Vote positif 0 Vote négatif
Re : extraction d'une cellule de feuil1 et la mettre dans une cellule de feuil2

Bonsoir,

bon là j'ai envie que l'insertion apres l'extraction de la premiere feuille, se fasse dans une une feuille deja existante qui porte le nom "Demandes closes".
comment je peux faire svp?
Cliquez pour agrandir...
Il suffit de lire mes annotations dans le code, c'est marqué comme sur le port salut 🙄

Tu changes cette ligne :
Code: 
 ' Nom de la feuille de Destination
  Set FeuilDst = ActiveSheet

Par :

Code: 
 ' Nom de la feuille de Destination
  Set FeuilDst = Sheets("Demandes closes")
Voili, voilà 😉
 
Vote positif 0 Vote négatif
Re : extraction d'une cellule de feuil1 et la mettre dans une cellule de feuil2


j'ai essayé cela, MAIS:

* il ajoute les trois ligne qui verifies le teste plusieurs fois, et il ne commence pas a partir de la premiere ligne vide

voila le code que j'ai mis:

Code: 
Option Explicit
Option Compare Text

Sub ExtractionListe()
  Dim DerLig As Long, Lig As Long
  Dim FeuilDst As Worksheet, DerLD As Long
  
  ' Définir la valeur de l'Objet FeuilDst
  ' Nom de la feuille de Destination
    Set FeuilDst = Sheets("Demandes closes")
  
  
  ' Avec la Feuille "suivi des demandes"
  With Sheets("Suivi des demandes")
    
    ' Trouver la dernière ligne
    DerLig = .Range("A" & Rows.Count).End(xlUp).Row
    
    ' Pour chaque ligne
    For Lig = 3 To DerLig
      
      ' Si le test est OK
      If .Range("AF" & Lig).Value <> "" Then
      
        'Colorer le numero en bleu
        .Range("B" & Lig).Font.Color = vbBlue
        
        ' Extraire les valeurs des colonnes
        'A, B, C, D, E, F, G, H, I, J, K, L, M, N, O, P, Q, R, S, T, U, V, W, X, Y, Z, AA, AB, AC, AD, AE, AF, AG, AH, AI, AJ, AK, AL, AM, AN, AO, AP, AQ, AR, AS, AT où le teste est vrai
        
        'Récupérer la dernière ligne de la feuille de destination
         DerLD = FeuilDst.Range("A" & Rows.Count).End(xlUp).Row
        
        ' Inscrire les valeurs
        FeuilDst.Range("A" & DerLD + 1).Value = .Range("A" & Lig).Value
        FeuilDst.Range("B" & DerLD + 1).Value = .Range("B" & Lig).Value
        FeuilDst.Range("C" & DerLD + 1).Value = .Range("C" & Lig).Value
        FeuilDst.Range("D" & DerLD + 1).Value = .Range("D" & Lig).Value
        FeuilDst.Range("E" & DerLD + 1).Value = .Range("E" & Lig).Value
        FeuilDst.Range("F" & DerLD + 1).Value = .Range("F" & Lig).Value
        FeuilDst.Range("G" & DerLD + 1).Value = .Range("G" & Lig).Value
        FeuilDst.Range("H" & DerLD + 1).Value = .Range("H" & Lig).Value
        FeuilDst.Range("I" & DerLD + 1).Value = .Range("I" & Lig).Value
        FeuilDst.Range("J" & DerLD + 1).Value = .Range("J" & Lig).Value
        FeuilDst.Range("K" & DerLD + 1).Value = .Range("K" & Lig).Value
        FeuilDst.Range("L" & DerLD + 1).Value = .Range("L" & Lig).Value
        FeuilDst.Range("M" & DerLD + 1).Value = .Range("M" & Lig).Value
        FeuilDst.Range("N" & DerLD + 1).Value = .Range("N" & Lig).Value
        FeuilDst.Range("O" & DerLD + 1).Value = .Range("O" & Lig).Value
        FeuilDst.Range("P" & DerLD + 1).Value = .Range("P" & Lig).Value
        FeuilDst.Range("Q" & DerLD + 1).Value = .Range("Q" & Lig).Value
        FeuilDst.Range("R" & DerLD + 1).Value = .Range("R" & Lig).Value
        FeuilDst.Range("S" & DerLD + 1).Value = .Range("S" & Lig).Value
        FeuilDst.Range("T" & DerLD + 1).Value = .Range("T" & Lig).Value
        FeuilDst.Range("U" & DerLD + 1).Value = .Range("U" & Lig).Value
        FeuilDst.Range("V" & DerLD + 1).Value = .Range("V" & Lig).Value
        FeuilDst.Range("W" & DerLD + 1).Value = .Range("W" & Lig).Value
        FeuilDst.Range("X" & DerLD + 1).Value = .Range("X" & Lig).Value
        FeuilDst.Range("Y" & DerLD + 1).Value = .Range("Y" & Lig).Value
        FeuilDst.Range("Z" & DerLD + 1).Value = .Range("Z" & Lig).Value
        FeuilDst.Range("AA" & DerLD + 1).Value = .Range("AA" & Lig).Value
        FeuilDst.Range("AB" & DerLD + 1).Value = .Range("AB" & Lig).Value
        FeuilDst.Range("AC" & DerLD + 1).Value = .Range("AC" & Lig).Value
        FeuilDst.Range("AD" & DerLD + 1).Value = .Range("AD" & Lig).Value
        FeuilDst.Range("AE" & DerLD + 1).Value = .Range("AE" & Lig).Value
        FeuilDst.Range("AF" & DerLD + 1).Value = .Range("AF" & Lig).Value
        FeuilDst.Range("AG" & DerLD + 1).Value = .Range("AG" & Lig).Value
        FeuilDst.Range("AH" & DerLD + 1).Value = .Range("AH" & Lig).Value
        FeuilDst.Range("AI" & DerLD + 1).Value = .Range("AI" & Lig).Value
        FeuilDst.Range("AJ" & DerLD + 1).Value = .Range("AJ" & Lig).Value
        FeuilDst.Range("AK" & DerLD + 1).Value = .Range("AK" & Lig).Value
        FeuilDst.Range("AL" & DerLD + 1).Value = .Range("AL" & Lig).Value
        FeuilDst.Range("AM" & DerLD + 1).Value = .Range("AM" & Lig).Value
        FeuilDst.Range("AN" & DerLD + 1).Value = .Range("AN" & Lig).Value
        FeuilDst.Range("AO" & DerLD + 1).Value = .Range("AO" & Lig).Value
        FeuilDst.Range("AP" & DerLD + 1).Value = .Range("AP" & Lig).Value
        FeuilDst.Range("AQ" & DerLD + 1).Value = .Range("AQ" & Lig).Value
        FeuilDst.Range("AR" & DerLD + 1).Value = .Range("AR" & Lig).Value
        FeuilDst.Range("AS" & DerLD + 1).Value = .Range("AS" & Lig).Value
        FeuilDst.Range("AT" & DerLD + 1).Value = .Range("AT" & Lig).Value

        
      End If
      
    Next Lig
    
  End With
  
End Sub
 
Vote positif 0 Vote négatif
Re : extraction d'une cellule de feuil1 et la mettre dans une cellule de feuil2

Re,

Je pensais qu'il fallait rajouter les données à celles existantes 😱

Le code (optimisé) est donc :
Code: 
Option Explicit
Option Compare Text

Sub ExtractionListe()
  Dim DerLig As Long, Lig As Long
  Dim FeuilDst As Worksheet, DerLD As Long
  
  ' Définir la valeur de l'Objet FeuilDst
  ' Nom de la feuille de Destination
    Set FeuilDst = Sheets("Demandes closes")
  'Récupérer la dernière ligne de la feuille de destination
    DerLD = FeuilDst.Range("A" & Rows.Count).End(xlUp).Row
  ' Effacer les données existantes
  FeuilDst.Range("A" & DerLD + 1 & ":AT" & DerLD).ClearContents
  
  ' Avec la Feuille "suivi des demandes"
  With Sheets("Suivi des demandes")
    ' Trouver la dernière ligne
    DerLig = .Range("A" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
    For Lig = 3 To DerLig
      ' Si le test est OK
      If .Range("AF" & Lig).Value <> "" Then
        'Colorer le numero en bleu
        .Range("B" & Lig).Font.Color = vbBlue
        ' Extraire les valeurs des colonnes
        'A à AT où le test est vrai
        'Récupérer la dernière ligne de la feuille de destination
         DerLD = FeuilDst.Range("A" & Rows.Count).End(xlUp).Row
        ' Inscrire les valeurs
        FeuilDst.Range("A" & DerLD + 1 & ":AT" & DerLD).Value = .Range("A" & Lig & ":AT" & Lig).Value
      End If
    Next Lig
  End With
End Sub

A tester 😉

A+
 
Vote positif 0 Vote négatif
Re : extraction d'une cellule de feuil1 et la mettre dans une cellule de feuil2


C'est Bon ça marche tres bien maintenant, en fait y'avait des lignes en bas de la feuille que je n'ai pas vu et qui traiait aussi.
Merci bcp pour ton aide;
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

A
  • Question Question
XL 2019 Copie d'une valeur dans la cellule à côté d'une valeur trouvé
Réponses
1
Affichages
177
sylvanu
R
  • Question Question
XL pour MAC Action d'une formule conditionnelle dans une cellule en fonction de la couleur de cette cellule
2
Réponses
17
Affichages
439
rtlv17
R
  • Question Question
XL 2019 Gérer la descente d'une cellule colorer selon un timer
2 3 4
Réponses
56
Affichages
2 K
Rheeem
R
C
  • Question Question
XL 2013 erreur dans une formule excel Sommeprod
2
Réponses
25
Affichages
642
Cattitude
C
F
  • Question Question
Autres Récupération de données d'une feuille X en fonction de la valeur de cellule dans une collone d'une feuille Y
2
Réponses
27
Affichages
958
fanfan38
D
  • Résolu(e)
Microsoft 365 VBA Déplacement de la cellule active dans une ligne sélectionnée
Réponses
11
Affichages
230
danielco
D
  • Résolu(e)
XL 2016 En VBA, Automatiser la réponse en fonction de l'état d'une cellule.
Réponses
7
Affichages
267
piga25
  • Question Question
XL 2016 XLS - Comment déterminer les zones présentent au niveau d'une cellule ?
Réponses
2
Affichages
248
Lu76Fer
Y
  • Question Question
XL 2019 Masquer automatiquement des lignes selon la valeur d'une cellule ?
Réponses
2
Affichages
156
Yogean
Y
C
  • Question Question
XL 2016 VBA - Mettre en Indice une partie du contenu d'une cellule : problème avec la propriété Font.Subscript
Réponses
2
Affichages
306
crocrocro
C
A
  • Résolu(e)
XL 2016 Recherche d'un mot dans une cellule et surlignage de la ligne
Réponses
4
Affichages
244
Abi23
A
J
  • Question Question
Microsoft 365 VBA Sum.if - Application de la formule dans la cellule et non pas sa valeur
Réponses
6
Affichages
335
JeanPi37
J
  • Question Question
Microsoft 365 Copie de couleur d'une cellule à une autre
Réponses
11
Affichages
725
Dranreb
Y
  • Question Question
XL 2013 Recherche d'une valeur de la feuil1 dans une base de la feuil2
Réponses
6
Affichages
488
job75
S
  • Question Question
XL 2013 enregistrer une feuille excel converti en pdf dans un répertoire selon la valeur d'une cellule
Réponses
5
Affichages
340
Phil69970
N
  • Résolu(e)
Microsoft 365 Supprimer de la liste d'une Combo les données déjà présentes dans une colonne d'un TS
2
Réponses
18
Affichages
760
NONO14
N
G
  • Question Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
597
GClaire
G
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
725
Gestionnaire_rh
G
T
  • Résolu(e)
Microsoft 365 Insérer une image DANS une cellule
Réponses
12
Affichages
1 K
Thomi
T
A
  • Question Question
XL 2021 récupérer la valeur d'une variable en fin de boucle dans une autre procédure
Réponses
5
Affichages
464
Attila451
A
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…