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

Créer une discussion
Répondre

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

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

BrunoM45 à dit:
Bonsoir,

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à 😉
Cliquez pour agrandir...

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

BrunoM45 à dit:
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+
Cliquez pour agrandir...

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
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
165
sylvanu
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
438
rtlv17
R
Nicolas JACQUIN
  • 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
640
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
950
fanfan38
fanfan38
D
  • Résolu(e)
Microsoft 365 VBA Déplacement de la cellule active dans une ligne sélectionnée
Réponses
11
Affichages
226
danielco
D
piga25
  • Résolu(e)
XL 2016 En VBA, Automatiser la réponse en fonction de l'état d'une cellule.
Réponses
7
Affichages
260
piga25
piga25
Lu76Fer
  • Question Question
XL 2016 XLS - Comment déterminer les zones présentent au niveau d'une cellule ?
Réponses
2
Affichages
238
Lu76Fer
Lu76Fer
Y
  • Question Question
XL 2019 Masquer automatiquement des lignes selon la valeur d'une cellule ?
Réponses
2
Affichages
147
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
302
crocrocro
C
A
  • Résolu(e)
XL 2016 Recherche d'un mot dans une cellule et surlignage de la ligne
Réponses
4
Affichages
235
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
treza88
  • Question Question
Microsoft 365 Copie de couleur d'une cellule à une autre
Réponses
11
Affichages
725
Dranreb
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
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
333
Phil69970
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
756
NONO14
N
G
  • Question Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
590
GClaire
G
G
  • Résolu(e)
XL 2016 Pb de tri et sous totaux
2
Réponses
27
Affichages
709
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
463
Attila451
A
Retour