XL 2016 Modifier un code de transfert ligne par ligne

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+++++
 

Scorpio

XLDnaute Impliqué
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
 

Patrice33740

XLDnaute Occasionnel
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
 

Scorpio

XLDnaute Impliqué
Salut Patrice33740
Je te remercie de tes efforts pour trouver une solution a mon soucis, mais c'est pas encore ça.
Je ne sais pas comment faire pour corriger ce code
B,C,G c'est bon, mais pas la colonne A
Merci A++++
 

Discussions similaires


Haut Bas