Déplacer données sauf si existantes

Bonjour,

J'essaye de copier/coller des données contenues dans différentes cellules d'une feuille "DWA" vers un tableau contenu dans une feuille "Suivi".

Je souhaite les déplacer sauf si les données ont déjà été copiées/collées. Pour celà, j'utilise une référence qui est dans la feuille "DWA" et je la compare si elle existe dans mon tableau "Suivi". J'utilise le code si dessous qui fonctionne pour copier/coller mais cela ne prend pas en compte ma condition de "si la référence est déjà dans mon tableau, ne pas copier/coller les données :

Sub Copier_Coller

REF_ENTREPRISE = ThisWorkbook.Worksheets("DWA").Range("A1")

DER_LIGNE_SUIVI = ThisWorkbook.Worksheets("Suivi").Range("Tableau1").ListObject.ListColumns(1).DataBodyRange(Range("Tableau1").Rows.Count).End(xlUp).Row + 1

KEY_SUIVI = ThisWorkbook.Worksheets("Suivi").Range("B" & DER_LIGNE_SUIVI)

If REF_ENTREPRISE <> KEY_SUIVI Then '

'REF ENTREPRISE
ThisWorkbook.Worksheets("Suivi").Range("B" & DER_LIGNE_SUIVI) = REF_ENTREPRISE

'1
'NOM ENTREPRISE
ThisWorkbook.Worksheets("Suivi").Range("A" & DER_LIGNE_SUIVI) = ThisWorkbook.Worksheets("DWA").Range("G51")

'Start date:
ThisWorkbook.Worksheets("Suivi").Range("E" & DER_LIGNE_SUIVI) = ThisWorkbook.Worksheets("DWA").Range("G52")

End If
'Next

End Sub

Une aide svp ?

Merci

Bonjour,

Poste le classeur.

Daniel

Bonjour,

Pardon, ci-joint le classeur.

L'idée est de copier/coller les cellules blanche de la feuille "DWA" sauf les cellules vides et si les cellules rattachées à une référence sont déjà copiées (éviter les doublons)

Merci

7classeur.xlsm (40.90 Ko)

Bonjour,

Où prends-tu les valeurs pour remplir la colonne Ref ?

Daniel

Bonjour Daniel,

Je compléterai la colonne F avec la formule MOIS.DECALER

Merci !

Bonjour,

Un petit up' !

Quelqu'un a une idée ?
Merci beaucoup !

Bonjour,

j'avais écrit ça :

Sub CopieSansDoblon()
  Dim C As Range, Ligne As Long, Sh As Worksheet, Teste As Boolean
  Dim I As Long, J As Long, K As Long
  Dim Company, Ref, RefPermit, Location, StartD, EndD
  Set Sh = Sheets("Suivi")
  With Sh
    Ligne = .[A:A].Find("*", , , xlPart, xlByRows, xlPrevious).Row
  End With
  With Sheets("DWA")
    For I = 6 To 22 Step 8
      For J = 1 To 25 Step 5
        Company = .Range("A1").Offset(J, I)
        StartD = .Range("A1").Offset(J + 1, I)
        EndD = .Range("A1").Offset(J + 2, I)
        Location = .Range("A1").Offset(J + 3, I)
        RefPermit = .Range("A1").Offset(J + 4, I)
        If Company = "" And StartD = "" And EndD = "" And Location = "" And _
         RefPermit = "" And Ref = "" Then
        Else
        'Company;Ref;Ref permit;Location;Start;End
          With Sh
            Teste = False
            Ligne = .[A:A].Find("*", , , xlPart, xlByRows, xlPrevious).Row
            For Each C In .Range("A3:A" & Ligne)
              If C = Company And C.Offset(, 1) = Ref And C.Offset(, 2) = _
                RefPermit And C.Offset(, 3) = Location And C.Offset(, 4) = _
                StartD And C.Offset(, 5) = EndD Then
                Teste = True
              End If
            Next C
            If Teste = False Then
              Ligne = Ligne + 1
              .Cells(Ligne, 1) = Company
              .Cells(Ligne, 2) = Ref
              .Cells(Ligne, 3) = RefPermit
              .Cells(Ligne, 4) = Location
              .Cells(Ligne, 5) = StartD
              .Cells(Ligne, 6) = EndD
            End If
          End With
        End If
      Next J
    Next I
  End With
End Sub

Essaie:

Daniel

Rechercher des sujets similaires à "deplacer donnees sauf existantes"