Plage de données

Bonsoir,

Voici mon problème je souhaiterai étendre plusieurs valeurs sur une certaine plage précises de données en pressant uniquement un bouton "Asphalt" ou "Dirt".

Le bouton Asphalt permettrai de prendre les 4 valeurs ci dessous et les étendrai jusqu’à la ligne 152 sauf les lignes 117, 122, 123, 124, 125, 126

De meme pour le bouton Dirt qui permettrai d'étendre jusqu'a la ligne 152 sauf les lignes 118, 127,128,129,130,131.

J'aimerai que ces boutons soit évidemment utilisable lorsque l'on va rajouter un nouvel événement.

Merci d'avance

Slt Remy,

Remy00 a écrit :

les 4 valeurs ci dessous

quelles valeurs exactement?

Excusez moi de ne pas avoir précisé ce sont les valeurs 10, 8, 156 et 174

ok merci, et pour doit on exclure les lignes 117, 122, 123, 124, 125, 126?

Ce sont des pièces qui sont uniquement utilisés pour les rallyes terres ou asphaltes donc certaines pièces ne sont pas utilisées donc à exclure.

ok donc pas de condition logique

à tester

Sub Asphalt()

Dim i As Integer
Application.ScreenUpdating = False

With ActiveSheet
    Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("G12:J12").Copy
    For i = 13 To Lastrow

        If .Cells(i, 6).Value <> "" And i <> 117 And i <> 122 And i <> 123 _
        And i <> 124 And i <> 125 And i <> 126 Then

            .Range("G" & i).PasteSpecial Paste:=xlPasteValues
        End If

    Next i
End With
Application.ScreenUpdating = True

End Sub

Celà à fonctionné une fois car j'étais sur la bonne page mais je n'arrive pas à prendre uniquement la page maintenance il faut bien modifier cette ligne. Et remplacer par la page souhaitée?

m3ellem1 a écrit :

With ActiveSheet

[/code]

Et aussi petit truc les données s’arrêtent à la ligne 137 au lieu de 152

Remy00 a écrit :

Celà à fonctionné une fois car j'étais sur la bonne page mais je n'arrive pas à prendre uniquement la page maintenance il faut bien modifier cette ligne. Et remplacer par la page souhaitée?

m3ellem1 a écrit :

With ActiveSheet

[/code]

oui c'est ca

Remy00 a écrit :

Et aussi petit truc les données s’arrêtent à la ligne 137 au lieu de 152

ajoute dans ton code

On Error Resume Next

J'ai réalisé les modifications précédentes et ça me surligne en jaune les 2 lignes avec une erreur 13 incompatibilité de type

m3ellem1 a écrit :

If .Cells(i, 6).Value <> "" And i <> 117 And i <> 122 And i <> 123 _

And i <> 124 And i <> 125 And i <> 126 Then

Ce code fonctionne chez mi sans problème!

Sub Asphalt()

Dim i As Integer
Application.ScreenUpdating = False
On Error Resume Next
With ActiveSheet
    Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("G12:J12").Copy
    For i = 13 To Lastrow

        If .Cells(i, 6).Value <> "" And i <> 117 And i <> 122 And i <> 123 _
        And i <> 124 And i <> 125 And i <> 126 Then

            .Range("G" & i).PasteSpecial Paste:=xlPasteValues
        End If

    Next i
End With
Application.ScreenUpdating = True

End Sub

Voici mon mon fichier avec votre code à l'inétieur dans le module Asphalte et apres il est relié au bouton Asphalte dans le userform SurfaceChoiceForm et il t'y possible que vous puissiez jeter un coup d'oeil ?

Merci d'avance

Slt,

Sub AsphaltExtend()

Dim i As Integer
Application.ScreenUpdating = False
On Error Resume Next
With Worksheets("Maintenance")
    Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    .Range("G12:J12").Copy
    For i = 13 To Lastrow

        If .Cells(i, 6).Value <> "" And i <> 117 And i <> 122 And i <> 123 _
        And i <> 124 And i <> 125 And i <> 126 Then

            .Range("G" & i).PasteSpecial Paste:=xlPasteValues
        End If

    Next i
End With
Application.ScreenUpdating = True

End Sub

Merci celà fonctionne uniquement sur le premier ajout mais c'est un bon début pour la suite merci beaucoup en tout cas