XL 2016 Modifier un code de transfert ligne par ligne

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Scorpio

XLDnaute Impliqué
Bonjour à tous,
J'ai un petit soucis pour modifier un code VBA.
En fait ce code transfert ligne par ligne sur une autre feuille et,
J'ai dans ce code cette ligne, qui supprime la formule en colonne G
dercel(2, 7) = dercel(2, 7).Value 'supprime la formule en colonne G

Et j'aimerais savoir comment faire le même code mais, pour supprimer 2 listes de validation en colonne A et C ??
Merci à tous,
A+++++
 
Bonjour Patrice33740
Voici le code complet.
Je ne suis pas un champion de VBA, j'ai essayé comme ci-dessous, mais cela ne marche pas
Merci de l'aide A++++

Sub DepLigneCouleur()
Dim cel As Range 'd?clare la variable cel (CELlule)
Dim dercel As Range 'd?clare la variable dest (DESTination)
Dim dl As Long 'd?clare la variable dl (Derni?re Ligne)
Dim x As Long 'd?clare la variable x
Application.ScreenUpdating = False 'masque les changements ? l'?cran
With Sheets("FactureOuverte") 'prend en compte l'onglet "FactureOuverte"
dl = .Range("A65536").End(xlUp).Row 'd?finit la variable dl
'boucle invers?e sur toutes les cellules ?dit?es de la colonne A (de la derni?re ? la premi?re)
For Each cel In .Range("A2:A" & dl)
'condition 1 : si la couleur d'encre de la cellule est rouge
If cel.Font.ColorIndex = 3 Then 'rouge
Set dercel = Sheets("FacturePay?").Range("A65536").End(xlUp)
cel.EntireRow.Cut dercel(2) 'coupe et colle la ligne
'dercel(2, 2).Resize(, 2).Validation.Delete 'supprime les listes de validation en colonnes B et C
Columns("A:A").Validation.Delete
dercel(2, 2) = dercel(2, 2).Value 'supprime la formule en colonne B
Columns("C:C").Validation.Delete
dercel(2, 7) = dercel(2, 7).Value 'supprime la formule en colonne G


End If
Next cel
'boucle invers?e sur toutes les cellules ?dit?es de la colonne A (de la derni?re ? la premi?re)
For x = dl To 2 Step -1
'condition 1 : si cellule est vide
If .Cells(x, 1).Value = "" Then
.Rows(x).Delete Shift:=xlShiftUp 'suprime la ligne
End If
Next x
End With
'Application.ScreenUpdating = True 'affiche les changements ? l'?cran
'Trie la feuil2 de A ? Z
Range("A2:H65536").Select
ActiveWorkbook.Worksheets("FacturePay?").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("FacturePay?").Sort.SortFields.Add Key:=Range("A2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("FacturePay?").Sort
.SetRange Range("A2:H65536")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("FacturePay?").Activate
Sheets("FacturePay?").Range("A1").Select
Sheets("FactureOuverte").Activate
Range("B1").Select
End Sub
 
Au lieu de :
If cel.Font.ColorIndex = 3 Then 'rouge
Set dercel = Sheets("FacturePay?").Range("A65536").End(xlUp)
cel.EntireRow.Cut dercel(2) 'coupe et colle la ligne
'dercel(2, 2).Resize(, 2).Validation.Delete 'supprime les listes de validation en colonnes B et C
Columns("A:A").Validation.Delete
dercel(2, 2) = dercel(2, 2).Value 'supprime la formule en colonne B
Columns("C:C").Validation.Delete
dercel(2, 7) = dercel(2, 7).Value 'supprime la formule en colonne G
End If
Essaies :
VB:
      If cel.Font.ColorIndex = 3 Then 'rouge
        Set dercel = Sheets("FacturePay?").Range("A65536").End(xlUp).Offset(1)
        cel.EntireRow.Cut dercel 'coupe et colle la ligne
        dercel.Validation.Delete 'supprime la liste de validation en colonnes A
        dercel.Offset(0, 1) = dercel.Offset(0, 1).Value 'supprime la formule en colonne B
        dercel.Offset(0, 2).Validation.Delete 'supprime la liste de validation en colonnes C
        dercel.Offset(0, 6) = dercel.Offset(0, 6).Value 'supprime la formule en colonne G
      End If
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour