Si pas de valeur dans la cellule passer à l'autre cellule
Bonjour , j'ai besoin de vos lumières pour un code qui est long à s'exécuter :
Quand il s'applique à une cellule sans valeur j'ai l'impression qu'il est long à s'exécuter.
Que mettre dans ce code pour ignorer les cellules sans valeurs et passer à la suivante ?
Sub Toute_la_feuille_affectations() 'Controle Affectations de toute la feuille
Dim Target As Range
ActiveSheet.Unprotect
Application.EnableEvents = False
Set Target = ActiveSheet().Range("F6:F41,N6:N30,V6:V37,AD6:AD39,N34:N41,P40:P41")
If flag Then Exit Sub
flag = True
On Error Resume Next
' A voir s'il n'y a pas de valeur ne pas traiter
flag = False
If flag Then Exit Sub
flag = True
Col = Array("F", "N", "V", "AD", "N", "P")
For n = 0 To UBound(Col)
For Each Cel In Range(Col(n) & "6:" & Col(n) & Range(Col(n) & "40").End(xlUp).Row)
For Each Cell In Sheets("Parc").Range("C7:C300")
If Cel.Value = Cell.Value Then
Cell.Copy Destination:=Cel
End If
Next Cell
Next Cel
Next n
flag = False
Application.EnableEvents = True
End SubMerci d'avance pour votre aide
Bonsoir,
En admettant que tu supprimes les passages surlignés, ta macro fonctionne
Cdlt.
Sub Toute_la_feuille_affectations() 'Controle Affectations de toute la feuille
Dim Target As Range
ActiveSheet.Unprotect
Application.EnableEvents = False
Set Target = ActiveSheet().Range("F6:F41,N6:N30,V6:V37,AD6:AD39,N34:N41,P40:P41")
If flag Then Exit Sub
flag = True
On Error Resume Next
' A voir s'il n'y a pas de valeur ne pas traiter
flag = False
If flag Then Exit Sub
flag = True
Col = Array("F", "N", "V", "AD", "N", "P")
For n = 0 To UBound(Col)
For Each Cel In Range(Col(n) & "6:" & Col(n) & Range(Col(n) & "40").End(xlUp).Row)
For Each Cell In Sheets("Parc").Range("C7:C300")
If Cel.Value = Cell.Value Then
Cell.Copy Destination:=Cel
End If
Next Cell
Next Cel
Next n
flag = False
Application.EnableEvents = True
End Sub
Bonsoir , oui en supprimant les lignes surlignés cela fonctionne.
Mais c'est toujours aussi lent
Bonsoir,
une autre optimisation possible, à voir l'impact sur les performances.
Sub Toute_la_feuille_affectations() 'Controle Affectations de toute la feuille
Dim Target As Range
ActiveSheet.Unprotect
Application.EnableEvents = False
Set Target = ActiveSheet().Range("F6:F41,N6:N30,V6:V37,AD6:AD39,N34:N41,P40:P41")
If flag Then Exit Sub
flag = True
On Error Resume Next
' A voir s'il n'y a pas de valeur ne pas traiter
flag = False
If flag Then Exit Sub
flag = True
Col = Array("F", "N", "V", "AD", "N", "P")
For n = 0 To UBound(Col)
set racol = Range(Col(n) & "6:" & Col(n) & Range(Col(n) & "40").End(xlUp).Row)
For Each Cel In racol
For Each Cell In Sheets("Parc").Range("C7:C300")
If Cel.Value = Cell.Value Then
Cell.Copy Destination:=Cel
End If
Next Cell
Next Cel
Next n
flag = False
Application.EnableEvents = True
End Sub
Bonsoir
Elle est sensée faire quoi cette macro ?
D'après ce que je comprends elle compare les données de plusieurs colonnes par rapport aux données d'une autre colonne (dans une autre page)
Si égalité tu copies : Pourquoi copier , si elles sont identiques ?
Un fichier serait plus approprié dans ce cas
Je te propose aussi une idée
Sub Toute_la_feuille_affectations() 'Controle Affectations de toute la feuille
Dim Target As Range
ActiveSheet.Unprotect
Application.EnableEvents = False
Set Target = ActiveSheet().Range("F6:F41,N6:N30,V6:V37,AD6:AD39,N34:N41,P40:P41")
If flag Then Exit Sub
flag = True
On Error Resume Next
' A voir s'il n'y a pas de valeur ne pas traiter
flag = False
If flag Then Exit Sub
flag = True
Col = Array("F", "N", "V", "AD", "N", "P")
For n = 0 To UBound(Col)
For Each cel In Range(Col(n) & "6:" & Col(n) & Range(Col(n) & "40").End(xlUp).Row)
If cel <> "" Then
For Each Cell In Sheets("Parc").Range("C7:C300")
If cel.Value = Cell.Value Then
Cell.Copy Destination:=cel
End If
Next Cell
End If
Next cel
Next n
flag = False
Application.EnableEvents = True
End SubMerci , Banzaï j'ai gagné en rapidité avec votre solution.
Encore merci