Microsoft 365 Copier Coller selon condition

  • Initiateur de la discussion Initiateur de la discussion eric72
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

eric72

XLDnaute Accro
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
VB:
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
 

Pièces jointes

Solution
un essai
VB:
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 &...
bonjour

déjà cette ligne, à mon avis ne donne rien: elle ne permet pas de parcourir ton tableau
VB:
For Each LigneSource In TableauSource.ListRows

à remplacer par
Code:
for i =1 to tableausource.listrows.count
Bonjour vgendron,

Merci pour ta réponse, j'ai modifié le code
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
 
un essai
VB:
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
 
un essai
VB:
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.
 
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. 😉
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
9
Affichages
369
Retour