Copier coller sous conditions

[pheonix00fr]

Bonjour, J'utilise la macro suivante pour copier sous condition des cellules d'une feuille "Liste" pour les coller dans une autre "ALD"

Sub Miseajourald()

li = Sheets("LISTE").Range("C5").End(xlDown).Row
If Sheets("LISTE").Range("C7") = "" Then li = 7
ligne = 5

For i = 5 To li
    If UCase(Sheets("LISTE").Range("F" & i)) = "X" Then
    Cells(ligne, 3) = Sheets("LISTE").Cells(i, 3)
    Cells(ligne, 4) = Sheets("LISTE").Cells(i, 4)
    Cells(ligne, 5) = Sheets("LISTE").Cells(i, 5)

ligne = ligne + 1
End If
Next

End Sub

Cela fonctionne bien la première fois, le problème vient d'une autre macro qui protège les lignes a prés validation par saisie d'une valeur sur la feuille "ALD"

Private Sub Worksheet_Change(ByVal Target As Range)
'Insertion de la date

'la ligne dont la colonne G a été saisi est verouillé
'La ligne suivante est deverouillée
Application.EnableEvents = True
If Target.Column <> 7 Then Exit Sub
ActiveSheet.Unprotect
Target.EntireRow.Select
Selection.Locked = True
lig = Target.Row
Cells(lig + 1, 1).EntireRow.Select
Selection.Locked = False
ActiveSheet.Protect

End Sub

Le problème est que la macro Miseajourald lis tout le tableau copie toutes les cellules dont la cellule "G" (exemple) contiens "X" et les colles en écrasant les cellules existante . Comme certaines cellules de "ALD" sont verrouillé ça plante.
Il fraudais adapter le code Miseajourald pour ne copier et coller que la ligne fraîchement validé pas "X".

Si quelqu'un peux m'aider?
Merci

 

[zeb]

Salut,

Je ne comprends pas bien ton problème.
Par ailleurs, clarifie ton code ! Pas de select, si tu n'as pas besoin de sélectionner.

J'ai réécrit ton code :

Private Sub Worksheet_Change(ByVal Target As Range)
	Application.EnableEvents = True
	If Target.Column <> 7 Then Exit Sub
	Me.UnProtect
	Target.EntireRow.Locked = True
	Target.EntireRow.Offset(1).Locked = False
	Me.Protect
End Sub

Sub Miseajourald()
	Dim li     As Range
	Dim source As Range
	Dim target As Range
	
	If Worksheets("LISTE").Range("C7") = "" Then 
		Set li = Worksheets("LISTE").Rows(7)
	Else
		Set li = Worksheets("LISTE").Range("C5").End(xlDown).EntireRow
	End If
	
	Set target = Me.Rows(5)
	
	For Each source In Me.Range(Me.Rows(5), li).Rows
		If UCase(source.Cells(6).Value) = "X" Then
			target.Cells(3).Value = source.Cells(3).Value
			target.Cells(4).Value = source.Cells(4).Value
			target.Cells(5).Value = source.Cells(5).Value
			Set target = target.Offset(1)
		End If
	Next
End Sub

Clarifie ton message ! Le code parle de cellule F, toi de cellule G.

Au fait, pourquoi deux fonctions ?
La fonction de mise à jour devrait lever la protection là où elle sait qu'elle va écrire, et bast !