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.

Il me met l'erreur suivante (mon excel est en Anglais)

capture

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é !

Super merci beaucoup

Rechercher des sujets similaires à "simplifiation code"