Copie d'une cellule sous condition

Résolu/Fermé
Signaler
Messages postés
10
Date d'inscription
vendredi 9 décembre 2016
Statut
Membre
Dernière intervention
16 janvier 2017
-
Messages postés
10
Date d'inscription
vendredi 9 décembre 2016
Statut
Membre
Dernière intervention
16 janvier 2017
-
Bonjour, voici mon problème je voudrait copier une cellule avec une macro que je déclenche avec un bouton voici la macro:
'*************************************************
'Procedure pour copier le code AEN13 de la ligne
'*************************************************
Sub copy_test()


Range("B5").Select
Selection.copy
Sheets("Feuil1").Select
Range("A1").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Sheets("Stock").Select

End Sub
sa fonctionne mais je suis obliger de créer autant de macros qu'il y a de lignes cet a dire plusieurs centaines, j'ai essayer avec
Sub copy_test()

Selection.Offset(0, -13).Select
Selection.copy
Sheets("Feuil1").Select
Range("A1").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Sheets("Stock").Select

End Sub
et la ca coince au moment de sélectionner la cellule après avoir parcourus les forums je me tourne vers vous

3 réponses

Messages postés
1412
Date d'inscription
mardi 21 octobre 2014
Statut
Membre
Dernière intervention
9 mars 2021
154
Bonjour Scheda, bonjour le forum,

Pas très clair tout ça !... Si tu veux copier toutes les lignes éditées de la colonne B de l'onglet Stock à partir de la ligne 5, dans la première ligne vide de la colonne A de l'onglet Feuil1, essaie ce code :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set OS = Worksheets("Stock") 'définit l'onglet source OS
Set OD = Worksheets("Feuil1") 'définit l'onglet destination OD
DL = OS.Cells(Application.Rows.Count, "B").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne B de l'onglet source OS
'définit la cellule de destination DEST (A1 si A1 est vide, sinon la première cellule vide de la colonne A de l'onglet destination OD)
Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0))
OS.Range("B5:B" & DL).Copy DEST 'copy la plage B5 à B...(dernière ligne éditée) dans la cellule DEST
End Sub

Messages postés
10
Date d'inscription
vendredi 9 décembre 2016
Statut
Membre
Dernière intervention
16 janvier 2017

ha pas facile de s'expliquer Dsl, non en fait je veux copier une cellule je m'explique
chaque ligne correspond a un produit avec prix d'achat, produit en stock, stock tampon, état du stock et d'autre colonnes .
quand la cellule état prend la forme "alerte" je click sur le bouton que j'ai placer juste a coté pour démarrer la macro qui copie la cellule en B5 qui contient la référence du produit que je veux commander et l'envoie sur la feuil1
voilà.
Messages postés
10
Date d'inscription
vendredi 9 décembre 2016
Statut
Membre
Dernière intervention
16 janvier 2017

voici le fichier la macro concernée se trouve dans la feuille STOCK,

http://www.cjoint.com/c/GAqmhGzRJHl
Messages postés
1412
Date d'inscription
mardi 21 octobre 2014
Statut
Membre
Dernière intervention
9 mars 2021
154
Re,

C'est mieux mais toujours pas complètement clair... Prend l'habitude quand tu envoies un fichier avec de nombreux onglets / Macros de spécifier de quel onglet il s'agit ainsi que de quelle macro. Ça nous simplifie la vie. Toi tu as le nez dedans, nous on découvre...

Comme tu ne dis pas ce que sont les colonnes 1, 2, 3 et 4 de l'onglet Feuil1. J'ai donc considéré que c'était, respectivement, les colonne C, D, E et F de l'onglet Stock... Le code :

'*************************************************
'Procedure pour copier le code AEN13 de la ligne
'*************************************************
Sub copy_test()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des valeurs)
Dim I As Long 'déclare la variable I (Incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set OS = Worksheets("Stock") 'définit l'onglet source OS
Set OD = Worksheets("Feuil1") 'définit l'onglet destination OD
DL = OS.Cells(Application.Rows.Count, "N").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne N de l'onglet source OS
TV = OS.Range("B5:N" & DL) 'définit le tableau des valeurs TV
K = 1 'initialise la variable K
For I = 1 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV
    If TV(I, 13) = "ALERTE" Then 'condition : si la donnée ligne i colonne 13 de TV est égale à "ALERTE"
        ReDim Preserve TL(1 To 5, 1 To K) 'redimensionne le tableau des lignes TL
        'transposition des données de TV à TL
        TL(1, K) = TV(I, 1) 'récupère dans la ligne 1 de TL la valeur de la donnée en colonne 1 de TV
        TL(2, K) = TV(I, 2) 'récupère dans la ligne 2 de TL la valeur de la donnée en colonne 2 de TV (à adapter)
        TL(3, K) = TV(I, 3) 'récupère dans la ligne 3 de TL la valeur de la donnée en colonne 3 de TV (à adapter)
        TL(4, K) = TV(I, 4) 'récupère dans la ligne 4 de TL la valeur de la donnée en colonne 4 de TV (à adapter)
        TL(5, K) = TV(I, 5) 'récupère dans la ligne 5 de TL la valeur de la donnée en colonne 5 de TV (à adapter)
        K = K + 1 'incrémente K
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
If K > 1 Then 'condition : si K est supérieure à 1
    Set DEST = IIf(OD.Range("A2").Value = "", OD.Range("A2"), OD.Range("A1").End(xlDown).Offset(1, 0)) 'définit la cellule de destination DEST
    DEST.Resize(UBound(TL, 2), UBound(TL, 1)).Value = Application.Transpose(TL) 'renvoie dans DEST redimensionnée le tableau TL transposé
End If 'fin de la condition
End Sub

Messages postés
10
Date d'inscription
vendredi 9 décembre 2016
Statut
Membre
Dernière intervention
16 janvier 2017

Dsl pour les explications peut clair néanmoins ta réponse m'a bien éclairer et j'ai solutionner mon affaire un grand merci pour m'avoir accorder un peut de ton temps