copie d'une cellule sous condition Résolu/Fermé

Question

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

ThauTheme · Answer

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

scheda · Answer

voici le fichier la macro concernée se trouve dans la feuille STOCK, 
http://www.cjoint.com/c/GAqmhGzRJHl

ThauTheme · Answer

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

Copie d'une cellule sous condition

3 réponses

Discussions similaires