copier coller sans doublons

[Evelynetfrancois]

bonjour a tous
je préleve un morceau de macro pour tenter d etre clair

i = Sheets(2).Range("b65535").End(xlUp).Row + 1
Sheets(2).Range("B" & i) = Sheets(1).Range("C3").Value

est une ligne de commande qui me renvoie feuille2 sur colonne B le contenu de la cellule C3 de la feuille 1(c est une date)
chaque activation de cette macro me renvoie la nouvelle valeur en dessous de la precedente , et ainsi de suite

pour eviter de copier deux fois les memes valeurs
quelle ligne de macro m eviterait de copier deux fois la meme date , ou me previendrait que la macro a deja copier le vendredi 17 novembre 2007 par exemple

merci d avance pour vos idées

E et F

 

[jp14]

Re : copier coller sans doublons

Bonsoir

Pour résoudre ce type de problème on utilise un flag ou en bon français un sémaphore.
data1 contient la valeur
trouve = 0

For i2 = 2 To Sheets("Table1").Range("A65536").End(xlUp).Row

If data1 = Sheets("Table2").Cells(i2, 1) Then
trouve = 1
Exit Sub
End If

Next i2
Un premier balayage permet de positionner ce sémaphore
dans un deuxième temps on réalise l'action en fonction de ce résultat.

JP

 

[Evelynetfrancois]

Re : copier coller sans doublons

Merci jp14 pour ta proposition
que malheureuselment je ne comprend pas ........dsl

voici la totalité de ma macro dans laquelle la valeur de C3 doit forcement etre differente de la valeur de la cellule directement au dessus , sinon msgbox etc ...


Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
'ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True
Dim i As Integer
i = Sheets(2).Range("b65535").End(xlUp).Row + 1
Sheets(2).Range("B" & i) = Sheets(1).Range("C3").Value
Sheets(2).Range("C" & i) = Sheets(1).Range("Q19").Value
Sheets(2).Range("D" & i) = Sheets(1).Range("R19").Value
Application.ScreenUpdating = True
Range("B8").Activate
End Sub

as tu la possibilité de m'aider ?

Merci beaucoup pour le temp passer pour moi !
E et F

 

[pierrejean]

Re : copier coller sans doublons

bonsoir Evelynetfrancois

a tester

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
'ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True
Dim i As Integer
i = Sheets(2).Range("b65535").End(xlUp).Row + 1
if Sheets(2).Rang("B" & i-1)<> Sheets(1).Range("C3").Value then
Sheets(2).Range("B" & i) = Sheets(1).Range("C3").Value
Else
msgbox("ATTENTION")
End if
Sheets(2).Range("C" & i) = Sheets(1).Range("Q19").Value
Sheets(2).Range("D" & i) = Sheets(1).Range("R19").Value
Application.ScreenUpdating = True
Range("B8").Activate
End Sub

en supposant que j'aie bien saisi le probleme

 

[bqtr]

Re : copier coller sans doublons

Bonsoir Evelynetfrancois, pierrejean, jp14

Essaye Ceci :

Private Sub CommandButton1_Click()
Dim plg As Range
Dim val
Dim i As Integer
nbr = 0
Application.ScreenUpdating = False
'ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True
i = Sheets(2).Range("b65535").End(xlUp).Row + 1
Cells(i, 2).Activate
Sheets(2).Range("B" & i) = Sheets(1).Range("C3").Value
Set plg = Sheets(2).Range("B2:B" & i + 1)
val = ActiveCell.Value
nbr = WorksheetFunction.CountIf(Range("B2:B" & i + 1), val)
If nbr > 1 Then
MsgBox "La date " & val & " existe déjà dans cette colonne !!! " & Chr(10) & "Modifier la Date.", , "Attention :"
ActiveCell.Clear
Sheets(1).Activate
Exit Sub
End If
Sheets(2).Range("C" & i) = Sheets(1).Range("Q19").Value
Sheets(2).Range("D" & i) = Sheets(1).Range("R19").Value
Application.ScreenUpdating = True
Range("A1").Activate
End Sub


Bonne soirée

P.O

 

[Robert]

Re : copier coller sans doublons

Bonsoir le fil, bonsoir le forum,

PierreJean, moi je l'ai saisi comme ça mais peut-être me trompe-je.

Private Sub CommandButton1_Click()
Dim i As Integer 'déclare la variable i
Dim plage As Range 'déclare la variable plage
Dim c As Range 'déclare la variable c
 
Application.ScreenUpdating = False
'ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True
With Sheets(2)
    i = .Range("B65535").End(xlUp).Row + 1 'définit la variable i
    Set plage = .Range("B2:B" & i) 'définit la variable plage
    'définit la variable c
    Set c = plage.Find(DateValue(Sheets(1).Range("C3")), , xlValues, xlWhole)
 
    If Not c Is Nothing Then 'condition : si il existe au moins une occurrence de la date
        MsgBox ("Date déjà éditée en " & c.Address(0, 0)) 'message
    Else 'sinon
        'copie les données
        Sheets(2).Range("B" & i) = Sheets(1).Range("C3").Value
        Sheets(2).Range("C" & i) = Sheets(1).Range("Q19").Value
        Sheets(2).Range("D" & i) = Sheets(1).Range("R19").Value
    End If 'fin de la condition
End With
Application.ScreenUpdating = True
Range("B8").Activate
End Sub

Édition :

Bonsoir P.O on s'est croisés. Encore une méthode pour Evelyne et François

 

[Evelynetfrancois]

Re : copier coller sans doublons

BONJOUR jp14 , pierrejean, robert ,bqtr ................................

Excusez moi pour le retard de ma réaction ..............
Mais j ai été "obligé" de participer activement à une soirée Beaujolais !


Je vous remercie pour toutes ces sujétions
Je vais faire tous les essais et adaptations nécessaires
Je vous tiens au courant sans faute !!
Au plaisir de vous lire
Bonne journée et encore un très grand merci !!!

E et F

 

[papapaul]

Re : copier coller sans doublons

😛 Salut les amis

C'est peut etre hors sujet mais ca peut aider

Le truc qu'on a fait avec un collegue (ci-dessous)
Ouvrir un fichier ou on a une bd sur une seule feuille.
Ensuite, on colle dans la feuille1 de notre
truc, en a1, la bd :
Apres on choisit une colonne
et ca crée autant d'onglets que d'items différents de cette colonne
sans double et en recopiant toutes les lignes ou y a l'item
dans l'onglet correspondant.

Faites l'essai avec une bd sans trop de lignes et dites-nous
si ca peut vous servir.
Si ca peut aider, on sera contents.

Amitiés à tous 🙂

 

[Evelynetfrancois]

Re : copier coller sans doublons

bonjour jp14 , pierrejean, robert ,bqtr papapaul................................

voila !!
j ai modifie ( sans aucunes prétentions) la macro de pierrejean (que je remercie une fois de plus) que je comprend mieux .
1 ) elle me previent du doublon (de la cell juste au dessus)
2 ) elle me permet d en faire le remplacement ou non !

Private Sub CommandButton1_Click()
Dim i As Integer
Application.ScreenUpdating = False
i = Sheets(2).Range("b65535").End(xlUp).Row + 1
If Sheets(2).Range("B" & i - 1) <> Sheets(1).Range("C3").Value Then
Sheets(2).Range("B" & i) = Sheets(1).Range("C3").Value
Sheets(2).Range("C" & i) = Sheets(1).Range("Q19").Value
Sheets(2).Range("D" & i) = Sheets(1).Range("R19").Value
'ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True
Else
Retour = MsgBox("Voulez-vous remplacer par cette nouvelle commande ? ", 4 + vbInformation, " Date de Commande déjà passée - LUNEVILLE ")
If Retour = vbYes Then
i = Sheets(2).Range("b65535").End(xlUp).Row
Sheets(2).Range("B" & i) = Sheets(1).Range("C3").Value
Sheets(2).Range("C" & i) = Sheets(1).Range("Q19").Value
Sheets(2).Range("D" & i) = Sheets(1).Range("R19").Value
'ActiveWindow.SelectedSheets.PrintOut Copies:=2, Collate:=True
End If
End If
Application.ScreenUpdating = True
Range("B8").Activate
End Sub

Merci à vous tous , vous êtes super !!

E et F