Microsoft 365 Copier Coller selon condition

[eric72]

Bonjour à tous,
J'ai un onglet "a Copier" avec un TS "TbSource", et un onglet "Archive" avec un TS "TbDestination" et j'aimerais que si la valeur de la colonne "Période & Site" existe déjà dans TbDestination alors on ne fait rien, sinon n'existe pas on copie et colle la ligne de TbSource vers TbDestination. J'ai écrit ce code mais il ne fonctionne pas, j'ai du oublier un paramètre

Sub CopierTableau()

 
    'Déclarer les variables
    Dim TableauSource As ListObject
    Dim TableauDestination As ListObject
    Dim LigneSource As ListRow
    Dim LigneDestination As ListRow
    Dim Recherche As Range, DateJour As String
    'Définir le tableau source
    Set TableauSource = Sheets("a Copier").ListObjects("TbSource")
 
    'Définir le tableau de destination
    Set TableauDestination = Sheets("Archive").ListObjects("TbDestination")
 
    'Vérifier si le tableau source existe
    If Not TableauSource Is Nothing Then
      
            For Each LigneSource In TableauSource.ListRows
                PeriodeSite = Sheets("a Copier").Range("TbSource[Période & Site]")
                Set C = Range("TbDestination[Période & Site]").Find(PeriodeSite, , xlValues, xlWhole)
                    If Not C Is Nothing Then
                        Set LigneDestination = TableauDestination.ListRows.Add
                        LigneDestination.Range(1, 1).Resize(1, TableauDestination.ListColumns.Count).Value = LigneSource.Range(1, 1).Resize(1, TableauDestination.ListColumns.Count).Value
                    End If
            Next LigneSource
        MsgBox "Vos Données sont bien enregistrées"
    End If
    'ViderTS
    
End Sub

Merci beaucoup pour votre aide!!!
Eric

 

[vgendron]

bonjour

déjà cette ligne, à mon avis ne donne rien: elle ne permet pas de parcourir ton tableau

For Each LigneSource In TableauSource.ListRows

à remplacer par

for i =1 to tableausource.listrows.count

 

[eric72]

bonjour

déjà cette ligne, à mon avis ne donne rien: elle ne permet pas de parcourir ton tableau

For Each LigneSource In TableauSource.ListRows

à remplacer par

for i =1 to tableausource.listrows.count

Bonjour vgendron,

Merci pour ta réponse, j'ai modifié le code

Sub CopierTableau()

 
    'Déclarer les variables
    Dim TableauSource As ListObject
    Dim TableauDestination As ListObject
    Dim LigneSource As ListRow
    Dim LigneDestination As ListRow
    Dim Recherche As Range, DateJour As String
    'Définir le tableau source
    Set TableauSource = Sheets("a Copier").ListObjects("TbSource")
 
    'Définir le tableau de destination
    Set TableauDestination = Sheets("Archive").ListObjects("TbDestination")
 
    'Vérifier si le tableau source existe
    If Not TableauSource Is Nothing Then
      
            For I = 2 To TableauSource.ListRows.Count
                PeriodeSite = Sheets("a Copier").Range("TbSource[Période & Site]")
                Set C = Range("TbDestination[Période & Site]").Find(PeriodeSite, , xlValues, xlWhole)
                    If Not C Is Nothing Then
                        Set LigneDestination = TableauDestination.ListRows.Add
                        LigneDestination.Range(1, 1).Resize(1, TableauDestination.ListColumns.Count).Value = TableauSource.Range(I, 1).Resize(1, TableauDestination.ListColumns.Count).Value
                    End If
            Next I
        MsgBox "Vos Données sont bien enregistrées"
    End If
    'ViderTS
    
End Sub

mais sans succès

 

[vgendron]

un essai

Sub CopierTableau()

 
    'Déclarer les variables
    Dim TableauSource As ListObject
    Dim TableauDestination As ListObject
    Dim LigneSource As ListRow
    Dim LigneDestination As ListRow
    Dim Recherche As Range, DateJour As String
    'Définir le tableau source
    Set TableauSource = Sheets("a Copier").ListObjects("TbSource")
 
    'Définir le tableau de destination
    Set TableauDestination = Sheets("Archive").ListObjects("TbDestination")
 
    'Vérifier si le tableau source existe
    If TableauSource Is Nothing Then Exit Sub
    
    With TableauSource
        For i = 1 To .ListRows.Count
            PeriodeSite = .DataBodyRange(i, 9)
            Set C = TableauDestination.ListColumns("Période & Site").Range.Find(PeriodeSite, , xlValues, xlWhole)
            If C Is Nothing Then
                TableauDestination.ListRows.Add
                LastLine = TableauDestination.ListRows.Count
                .ListRows(i).Range.Copy Destination:=TableauDestination.ListRows(LastLine).Range
            End If
        Next i
    End With
    MsgBox "Vos Données sont bien enregistrées"

    'ViderTS
    
End Sub

 

[eric72]

un essai

Sub CopierTableau()

 
    'Déclarer les variables
    Dim TableauSource As ListObject
    Dim TableauDestination As ListObject
    Dim LigneSource As ListRow
    Dim LigneDestination As ListRow
    Dim Recherche As Range, DateJour As String
    'Définir le tableau source
    Set TableauSource = Sheets("a Copier").ListObjects("TbSource")
 
    'Définir le tableau de destination
    Set TableauDestination = Sheets("Archive").ListObjects("TbDestination")
 
    'Vérifier si le tableau source existe
    If TableauSource Is Nothing Then Exit Sub
   
    With TableauSource
        For i = 1 To .ListRows.Count
            PeriodeSite = .DataBodyRange(i, 9)
            Set C = TableauDestination.ListColumns("Période & Site").Range.Find(PeriodeSite, , xlValues, xlWhole)
            If C Is Nothing Then
                TableauDestination.ListRows.Add
                LastLine = TableauDestination.ListRows.Count
                .ListRows(i).Range.Copy Destination:=TableauDestination.ListRows(LastLine).Range
            End If
        Next i
    End With
    MsgBox "Vos Données sont bien enregistrées"

    'ViderTS
   
End Sub

C'est exactement ça, j'ai pourtant essayé, je me rapproche mais n'ai pas réussi!!!
Merci beaucoup pour ton aide encore une fois.
Bonne journée.

 

[TooFatBoy]

Bonjour,

Juste une toute petite remarque : l'un des avantages des TS est qu'on peut les déplacer, dans la feuille dans laquelle ils se trouvent ou vers une autre feuille.

Pour garder cette possibilité sans avoir besoin de modifier le code des macros à chaque déplacement, il faut ne pas préciser le nom de la feuille lors de la définition de l'alias. 😉