Copie oui mais, si en double non !

[WDAndCo]

Bonjour le Forum

Bonjour j'ai ce code, j'aimerais que cette Macro ne colle pas cette nouvelle ligne si les valeurs des cellules A et BG sont égales à une des lignes déjà en place sur cette feuilles.

Sub CopieCompteur()
    Sheets("Compteurs").Select
    Rows("6:6").Select
    Selection.Copy
    Rows("6:6").Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
    Sheets("EVS à jour").Select
    Rows("76:76").Select
    Range("B76").Activate
    Selection.Copy
    Sheets("Compteurs").Select
    Rows("6:6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select  
    Sheets("EVS à jour").Select
End Sub

D'avance merci.
Dominique

[Edit]
J'ai trouvé cela en cumulant A et BG en BI

Sub CopieCompteur()
    Sheets("Compteurs").Select
    Rows("6:6").Select
    Selection.Copy
    Rows("6:6").Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
    Sheets("EVS à jour").Select
    Rows("76:76").Select
    Range("B76").Activate
    Selection.Copy
    Sheets("Compteurs").Select
    Rows("6:6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
     
Dl = Range("BI65536").End(xlUp).Row
Dl = Dl
For Lg = Dl To 7
    If Range("BI6").Value = Range("BI" & Lg).Value Then Rows("Lg").Delete
Next
    Range("A1").Select
  
    Sheets("EVS à jour").Select
End Sub

Je peux ?
[\Edit]

 

[Paritec]

Re : Copie oui mais, si en double non !

Bonjour Dom le forum
juste pour info tes select ne servent à rien

exemple

Sheets("Compteurs").Select
    Rows("6:6").Select
    Selection.Copy

tu peux l'écrire

Sheets("Compteurs").Rows(6).copy

ensuite si on lit ta macro en fait, tu veux copier la cellule B76 de Sheets("EVS à jour") en ligne 6 de Sheets("Compteurs")
car tu sélectionnes la ligne 6 et ensuite tu actives la cellule B76 donc tu désélectionnes la ligne 6 ????
Tu veux quoi copier la ligne 76 de Sheets("EVS à jour")?
Encore une chose, tu colles et après tu vérifies, non il faut vérifier si la ligne est déjà présente et si non insérer la ligne 6 dans Compteur et coller la ligne 76
enfin c'est ce que j'ai compris
a te relire

bonne journée
Papou

 

[WDAndCo]

Re : Copie oui mais, si en double non !

Bonjour le Forum et Papou

Sub CopieCompteur()

Sheets("Compteurs").Select
  
    Rows("6:6").Select 'Copie de la ligne 6 en ligne 6 
    Selection.Copy
    Rows("6:6").Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
    
Sheets("EVS à jour").Select
    
    Rows("76:76").Select 'Copie de la ligne 76
    Range("B76").Activate
    Selection.Copy
    
Sheets("Compteurs").Select
    
    Rows("6:6").Select 'Copie de la ligne 76 de EVS à jour sur la nouvelle ligne 6 de Compteurs
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
 Dl = Range("BI65536").End(xlUp).Row 'Vérification de la nouvelle ligne si elle est déja présente Delete de l'ancienne. 
Dl = Dl
For Lg = 7 To Dl
    If Range("BI6").Value = Range("BI" & Lg).Value Then Rows(Lg).Delete
Next
              
    Range("A1").Select
    
Sheets("EVS à jour").Select
End Sub

Voici, la dernière V du code qui fonctionne ! Mais il doit surement y avoir plein de trucs inutiles !

 

[Paritec]

Re : Copie oui mais, si en double non !

Re Bonjour Dom le forum
essaye cela
mais il faut savoir si la ligne que tu copies et strictement la même ou s'il y a des différences à par la valeur de BI ???
si oui alors il faut vérifier avant de coller et non copier coller et après supprimer
a+
Papou

Sub CopieCompteur()
Dim Dl&, lg&
    Sheets("Compteurs").Rows(6).Insert Shift:=xlDown
    Sheets("EVS à jour").Rows("76:76").Copy
    Sheets("Compteurs").Rows(6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    With Sheets("Compteurs")
        Dl = .Range("BI" & Rows.Count).End(xlUp).Row
        For lg = 7 To Dl
            If .Range("BI6").Value = .Range("BI" & lg).Value Then .Rows(lg).Delete
        Next
        .Range("A1").Select
    End With
    Sheets("EVS à jour").Select
End Sub

Papou

 

[WDAndCo]

Re : Copie oui mais, si en double non !

Bonjour le Forum et Papou,

BI est égal au nom et le mois donc il ne peut en avoir qu’une, et la nouvelle supprime l’ancienne. Donc il faut bien coller, puis supprimer l’ancienne.

Le code ne fonctionne pas car j’ai cela sur les feuilles :

Private Sub Worksheet_Activate()
Columns("A").EntireColumn.Hidden = True
Columns("BH:BI").EntireColumn.Hidden = True
Columns("B:BH").Select

ActiveWindow.Zoom = True
Range("D7").Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = [d7].Address Or Target.Address = [BG7].Address Then MAJ
End Sub

Ou

Private Sub Worksheet_Activate()
Columns("BH:BI").EntireColumn.Hidden = True
Columns("A:BG").Select
ActiveWindow.Zoom = True
Range("A6").Select
End Sub

If Target.Address = [d7].Address Or Target.Address = [BG7].Address Then MAJ

C'est cela qui déclenche la copie dans Compteurs à l'aide de MAJ

 

[Paritec]

Re : Copie oui mais, si en double non !

Re Dom le forum
bah oui comme dab pas de fichier alors il faut deviner bref
a+
Papou