XL 2016 Ajout N°

[Bruce68]

Bonjour à tous
Je cherche à faire une macro qui vérifie dans la colonne C (Sauvegarde) si le N° de la colonne F existe, si il existe je ne fais rien si il n'existe pas je met le N° dans la colonne C en Sauvegarde, voir fichier joint.
Je vous remercie de votre aide

 

[JBARBE]

Bonjour à tous,
Peut-être ceci en cliquant sur le bouton GO !
Bonne journée !

 

[sylvanu]

Bonjour Bruce, Jbarbe,
Un essai en PJ. La vérification est automatique par validation d'une valeur dans la colonne F.

Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("F1:F1000")) Is Nothing Then
        DerLig = Range("C65500").End(xlUp).Row
        If Application.CountIf(Range("C:C"), Target) = 0 Then
            Cells(DerLig + 1, "C") = Target
        End If
    End If
Fin:
End Sub

 

[JBARBE]

Re,
Il y a maintenant les lignes correspondant aux sauvegardes !
Bonne soirée !

 

[JBARBE]

Re,
Les sauvegardes colonne F sont mis en jaune colonne C !
Bonne soirée !

 

[Bruce68]

Bonsoir sylvanu, JBARBE et le forum
Un grand merci pour vos macros qui me conviennent.
Bonne soirée à tous

 

[Bruce68]

re bonsoir à tous
J'ai un petit souci de recopie je dois recopier plusieurs cellules. en gras dans l 'exemple
If .Cells(j, 1) = 0 And .Cells(j, 6) <> "" Then
DerLg = .Range("C" & .Rows.Count).End(xlUp).Row + 1
.Range("C" & DerLg) = .Cells(j, 6), .Cells(j, 10)
Je vous remercie de votre aide

 

[sylvanu]

Bonsoir,
Une possibilité :

.Range(Cells(j, 6), Cells(j, 10)).Copy Destination:=.Range("C" & DerLg)

 

[JBARBE]

Bonjour à tous,
Copie de la colonne 6 à 10 ! dans la colonne C (3)
En gras si toute la saisie de la colonne C est concernée !

Sub tester()
Dim j As Long, DerLg As Long, i As Long
Application.ScreenUpdating = False
With Sheets("base")
For j = 2 To [D1]
  If .Cells(j, 1) = 0 And .Cells(j, 6) <> "" Then
   DerLg = .Range("C" & .Rows.Count).End(xlUp).Row + 1
   .Range("C" & DerLg) = Range(.Cells(j, 6), .Cells(j, 10))
  ElseIf .Cells(j, 6) = "" Then
  Exit For
  End If
Next j
For i = 2 To [D1] + 1
.Cells(i, 3).Font.Bold = True
Next i
End With
Call couleurs
Application.ScreenUpdating = True
End Sub

 

[JBARBE]

Re,
Il y avait un problème de copie de cellules !
Maintenant il suffit de renseigner le début de colonne à copier et la fin de colonne à copier ( dans l'exemple du fichier de 6 à 10 ) !
Bonne journée

Sub tester()
Dim j As Long, DerLg As Long, i As Long, reponseD As Long, reponseA As Long, k As Long
Application.ScreenUpdating = False
With Sheets("base")
reponseD = InputBox("Veuillez indiquer la colonne de départ à copier (exemple:6)")
reponseA = InputBox("Veuillez indiquer la colonne d'arrivée à copier (exemple:10)")
For j = 2 To [D1]
  If .Cells(j, 1) = 0 And .Cells(j, 6) <> "" Then
  For k = reponseD To reponseA
   If k = reponseD Then
   DerLg = .Range("C" & .Rows.Count).End(xlUp).Row + 1
   .Range("C" & DerLg) = .Cells(j, k)
   .Range("C" & DerLg).Select
   Else
   ActiveCell = ActiveCell & .Cells(j, k)
   End If
  Next k
  ElseIf .Cells(j, 6) = "" Then
  Exit For
  End If
Next j
For i = 2 To [D1] + 1
.Cells(i, 3).Font.Bold = True
Next i
End With
Call couleurs
Application.ScreenUpdating = True
End Sub

 

[Bruce68]

Bonjour Jbarbe et le forum
Merci pour les 2 réponses maintenant la macro fonctionne (Voir fichier joint complet)
comment adapter la macro de sylvanu à mon fichier.
Je vous remercie pour toute votre aide

 

[JBARBE]

Re,
Peut-être ceci !
En effectuant la saisie de la colonne 27 à 35 !
Bonne soirée !