Discussion :

[alpilon]

Bonjour

Je LOAD Toutes les valeurs de la Feuil3 à la Feuil2 en une seule fois, mais j'aimerais qu'il me fasse la recopie des lignes adjacentes de la feuil2 en même temps.Voir fichier joint.



Comment faire ?

Code Feuil3

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub Copie()
     Sheets("Feuil2").Range("D7:D20").Value = Sheets("Feuil3").Range("A1:A14").Value
    MsgBox "Transfert Terminé - Allez à la Feuil2"
End Sub

Code Feuil2
Pour l'instant le code éxécute la macro ligne par ligne chaque fois que je rentre un nombre en A Feuil3

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False 'Désactive les évènements
Dim DerLig As Long 'Variable pour récupérér la dernière ligne utilisée => +1 = où copier
DerLig = Cells(Columns(3).Cells.Count, 3).End(xlUp).Row 'Récupère le numéro de la dernière ligne remplie => A copier'
If Target.Row <> DerLig + 1 Or Target.Column <> 4 Then Exit Sub 'Si la cellule modifiée est différente de la cible on sort
 
Cells(DerLig, 3).Copy Destination:=Cells(DerLig + 1, 3) 'Copie la dernière ligne de la colonne C sur celle du dessous
Range(Cells(DerLig, 5), Cells(DerLig, 18)).Copy Destination:=Cells(DerLig + 1, 5) 'Copie la dernière ligne de la colonne C sur celle du dessous
Application.EnableEvents = True 'Réactive les évènements
End Sub

Merci

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub Copie()
Dim LastLig As Long, i As Long
 
With Sheets("Feuil2")
    LastLig = .Cells(.Rows.Count, 4).End(xlUp).Row
    For i = 1 To 14
        LastLig = LastLig + 1
        .Range("D" & LastLig).Value = Sheets("Feuil3").Range("A" & i).Value
    Next i
End With
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Worksheet_Change(ByVal Target As Range)
Dim DerLig As Long
 
DerLig = Cells(Rows.Count, 3).End(xlUp).Row
If Target.Cells.Count > 1 Or Target.Row <> DerLig + 1 Or Target.Column <> 4 Then Exit Sub
 
Application.EnableEvents = False
Cells(DerLig, 3).Copy Destination:=Cells(DerLig + 1, 3)
Range(Cells(DerLig, 5), Cells(DerLig, 18)).Copy Destination:=Cells(DerLig + 1, 5)
Application.EnableEvents = True
 
End Sub

Attention où tu mets tes Application.EnableEvents
déjà reportés dans un de tes posts!

[ouskel'n'or]

Bonjour mercatog, alpilon,

Attention où tu mets tes Application.EnableEvents

Tu peux expliquer ? Pour ma part j'aurais placé cette ligne au même endroit qu'alpilon.
Juste pour pas mourir idiot

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Application.EnableEvents = False 'Désactive les évènements
Dim DerLig As Long 'Variable pour récupérér la dernière ligne utilisée => +1 = où copier
DerLig = Cells(Columns(3).Cells.Count, 3).End(xlUp).Row 'Récupère le numéro de la dernière ligne remplie => A copier'
If Target.Row <> DerLig + 1 Or Target.Column <> 4 Then Exit Sub '

à cause du Exit Sub

[alpilon]

Comme d'habitude c'est parfait mercatog

Merci pour ta diligence et tes conseils à propos

[alpilon]

C'est Résolu mais je mets ce code en plus, le même code de Mercatog mais pour sélectionner la colonne A jusqu'à la dernière cellule non vide (LastCel) qui fonctionne parfaitement :

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
Sub Copie()
Dim LastLig As Long, i As Long
Dim LastCel As Long
 
 
With Sheets("Feuil2")
    LastLig = .Cells(.Rows.Count, 4).End(xlUp).Row
    LastCel = Cells.Find("*", , , , , xlPrevious).Row
    For i = Cells(1, 1) To Cells(LastCel, 1)
        LastLig = LastLig + 1
        .Range("D" & LastLig).Value = Sheets("Feuil3").Range("A" & i).Value
    Next i
End With
    MsgBox "Transfert Terminé - Allez à la Feuil2"
End Sub

[ouskel'n'or]

à cause du Exit Sub

Ok, je ne l'avais pas vu
Merci