Simplifiation de code
Bonjour
Etant novice en VBA, j'ai recupere plusieurs morceaux de code pour n'en faire qu'un. Cependant cela me fait un enorme code dont je suis sur qu'il est simplifiable.
Concretement, ce code a pour but de remplir une ligne de la feuille DATAS a partir des donnees rentrees sur la feuille CALCULATION. Chaque appui sur le bouton entraine l'inscription sur une nouvelle ligne. A l'heure actuelle, mon code fait que je rempli les colonnes une par une mais est-il possible d'inverser et de remplir toute la ligne ?
Merci d'avance
Le code en question :
Sub Add_To_List()
Dim cel_src, cel_dst As Range
Set cel_src = Worksheets("CALCULATION").Range("G4")
With Worksheets("Datas")
Set cel_dst = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
cel_dst.Value = cel_src.Value
Set cel_src = Worksheets("CALCULATION").Range("G6")
With Worksheets("Datas")
Set cel_dst = .Cells(.Rows.Count, "C").End(xlUp).Offset(1, 0)
End With
cel_dst.Value = cel_src.Value
Set cel_src = Worksheets("CALCULATION").Range("D12")
With Worksheets("Datas")
Set cel_dst = .Cells(.Rows.Count, "D").End(xlUp).Offset(1, 0)
End With
cel_dst.Value = cel_src.Value
Set cel_src = Worksheets("CALCULATION").Range("D22")
With Worksheets("Datas")
Set cel_dst = .Cells(.Rows.Count, "E").End(xlUp).Offset(1, 0)
End With
cel_dst.Value = cel_src.Value
Set cel_src = Worksheets("CALCULATION").Range("D15")
With Worksheets("Datas")
Set cel_dst = .Cells(.Rows.Count, "F").End(xlUp).Offset(1, 0)
End With
cel_dst.Value = cel_src.Value
Set cel_src = Worksheets("CALCULATION").Range("D17")
With Worksheets("Datas")
Set cel_dst = .Cells(.Rows.Count, "G").End(xlUp).Offset(1, 0)
End With
cel_dst.Value = cel_src.Value
Set cel_src = Worksheets("CALCULATION").Range("D19")
With Worksheets("Datas")
Set cel_dst = .Cells(.Rows.Count, "H").End(xlUp).Offset(1, 0)
End With
cel_dst.Value = cel_src.Value
Set cel_src = Worksheets("CALCULATION").Range("D9")
With Worksheets("Datas")
Set cel_dst = .Cells(.Rows.Count, "I").End(xlUp).Offset(1, 0)
End With
cel_dst.Value = cel_src.Value
Set cel_src = Worksheets("CALCULATION").Range("D34")
With Worksheets("Datas")
Set cel_dst = .Cells(.Rows.Count, "J").End(xlUp).Offset(1, 0)
End With
cel_dst.Value = cel_src.Value
'Validation
Set cel = .Cells(.Rows.Count, "K").End(xlUp).Offset(1, 0)
If MsgBox("Valid the Quotation ?", vbYesNo, "Sondage") = vbYes Then
cel.Interior.ColorIndex = 4
Else
cel.Interior.ColorIndex = 4
End If
End Sub
Bonjour,
Essaie ainsi :
Sub Add_To_List()
Dim cel_src, cel_dst As Range, wsCal As Worksheet, i%
cel_src = Split("G4 G6 D12 D22 D15 D17 D19 D9 D34")
cel_dst = Split("A C D E F G H I J")
Set wsCal = Worksheets("CALCULATION")
With Worksheets("Datas")
For i = 0 To UBound(cel_dst)
.Range(cel_dst(i) & .Rows.Count).End(xlUp)(2) = wsCal.Range(cel_scr(i))
Next i
i = MsgBox("Valid the Quotation ?", vbYesNo, "Sondage") - vbYes
.Range("K" & .Rows.Count).End(xlUp)(2).Interior.Color = IIf(i = 0, vbGreen, vbRed)
End With
End Sub
Cordialement.
Une suppression oubliée :
Sub Add_To_List()
Dim cel_src, cel_dst, wsCal As Worksheet, i%
cel_src = Split("G4 G6 D12 D22 D15 D17 D19 D9 D34")
cel_dst = Split("A C D E F G H I J")
Set wsCal = Worksheets("CALCULATION")
With Worksheets("Datas")
For i = 0 To UBound(cel_dst)
.Range(cel_dst(i) & .Rows.Count).End(xlUp)(2) = wsCal.Range(cel_scr(i))
Next i
i = MsgBox("Valid the Quotation ?", vbYesNo, "Sondage") - vbYes
.Range("K" & .Rows.Count).End(xlUp)(2).Interior.Color = IIf(i = 0, vbGreen, vbRed)
End With
End Sub
Super ca marche
Mais juste un petit truc : la case qui se colore en vert ou rouge reste toujours la meme : elle ne change pas de ligne.
Comment faire pour que la ligne concernee soit aussi coloree en rouge ou vert ?
Si elle est vide, c'est normal ! Il faut y mettre quelque chose pour que l'on puisse passer à la suivante.
Meme en mettant quelque chose ca ne va pas. J'ai juste rajoute une nouvelle cellule a copier mais ca colore sur la ligne du dessous.
Voici le code :
Sub Add_To_List()
Dim cel_src, cel_dst, wsCal As Worksheet, i%
cel_src = Split("G4 G1 G6 D12 D22 D15 D17 D19 D9 D34 A1")
cel_dst = Split("A B C D E F G H I J K")
Set wsCal = Worksheets("CALCULATION")
With Worksheets("Datas")
For i = 0 To UBound(cel_dst)
.Range(cel_dst(i) & .Rows.Count).End(xlUp)(2) = wsCal.Range(cel_src(i))
Next i
i = MsgBox("Valid the Quotation ?", vbYesNo, "Sondage") - vbYes
.Range("K" & .Rows.Count).End(xlUp)(2).Interior.Color = IIf(i = 0, vbGreen, vbRed)
End With
End Sub
Comme ça :
...
Next i
i = MsgBox("Valid the Quotation ?", vbYesNo, "Sondage") - vbYes
With .Range("K" & .Rows.Count).End(xlUp)(2)
.Interior.Color = IIf(i = 0, vbGreen, vbRed)
.Value = "?" 'mettre le contenu qu'on veut !
End With
End With
End Sub
Tu colores et mets une valeur, la fois d'après, ce sera la cellule suivante...
NB-J 'indente le code de façon systématique et dans les règles, je préfèrerais ne pas le voir désindenté !