Microsoft 365 copier coller Resize

eric72 · 26 Janvier 2024

Bonsoir,
Je cherche à copier des plages de la feuille ORIGINEà DESTINATION avec un test pour savoir si la Référence Devis existe, ça j'y parviens sauf que j'aimerais coller dans un 1er temps de la colonne A à E (j'y arrive aussi!!!) puis de la colonne I à K avec une solution type RESIZE mais je n'y parviens pas.

Merci beaucoup pour votre aide.

TooFatBoy · 29 Janvier 2024

Voici la macro qui a l'air de fonctionner. A tester...

VB:

Sub Copier_Valeurs()
' Modification/ajout des données du tableau source dans le tableau cible
Dim LigneSource As Long, LigneCible As Long
Dim MaValeur As String
Dim MaPlageDeRecherche As Range, MaCelluleTrouvee As Range

    Application.ScreenUpdating = False

    For LigneSource = 1 To Range("TbOrigine").ListObject.ListRows.Count

        MaValeur = Range("TbOrigine[Référence Devis]")(LigneSource).Value
        Set MaPlageDeRecherche = Range("TbDestination[Référence Devis]")
        Set MaCelluleTrouvee = MaPlageDeRecherche.Find(What:=MaValeur, LookIn:=xlValues, LookAt:=xlWhole)

        If MaCelluleTrouvee Is Nothing Then...

eric72 · 29 Janvier 2024

TooFatBoy à dit:
Bizarre car chez moi c'est au moment de la recherche que ça plante, et je ne comprends pas pourquoi.

je pense qu'après le 1er enregistrement, il fait la recherche dans une ligne qui est en dehors du tableau, ce qui le fait beuguer

TooFatBoy · 29 Janvier 2024

eric72 à dit:
je pense qu'après le 1er enregistrement, il fait la recherche dans une ligne qui est en dehors du tableau, ce qui le fait beuguer

J'ai pensé aussi à une bêtise de ce genre, c'est pourquoi j'ai ajouté une ligne pour réinitialiser MaCible, mais ça ne change rien

Ca plante toujours (après l'ajout d'une première ligne) lorsque la valeur n'est pas trouvée.
En revanche, si la valeur est trouvée, ça ne plante pas.

Après l'ajout d'une première ligne, tant que les nouvelles valeurs cherchées sont trouvées dans le tableau cible, tout se passe bien, ça ne plante pas.
En revanche, dès qu'une valeur n'est pas trouvée dans le tableau cible, ça plante.

Bref, comme je disais au départ, mon code est tout moisi !...
Il faut chercher une autre façon de faire.

eric72 · 29 Janvier 2024

TooFatBoy à dit:
J'ai pensé aussi à une bêtise de ce genre, c'est pourquoi j'ai ajouté une ligne pour réinitialiser MaCible, mais ça ne change rien

Ca plante toujours (après l'ajout d'une première ligne) lorsque la valeur n'est pas trouvée.
En revanche, si la valeur est trouvée, ça ne plante pas.

Après l'ajout d'une première ligne, tant que les nouvelles valeurs cherchées sont trouvées dans le tableau cible, tout se passe bien, ça ne plante pas.
En revanche, dès qu'une valeur n'est pas trouvée dans le tableau cible, ça plante.

Bref, comme je disais au départ, mon code est tout moisi !...
Il faut chercher une autre façon de faire.

en fait

VB:

Set MaCible = Nothing

il semble que cela ne change rien

TooFatBoy · 29 Janvier 2024

eric72 à dit:
en fait

VB:

Set MaCible = Nothing

il semble que cela ne change rien

Oui, c'est même sûr.

Ca fait partie des lignes que j'ai ajoutées pour essayer de trouver et contourner le problème.

eric72 · 29 Janvier 2024

TooFatBoy à dit:
Oui, c'est même sûr.

Ca fait partie des lignes que j'ai ajoutées pour essayer de trouver et contourner le problème.

et pourtant il semble que tu es proche de la vérité

TooFatBoy · 29 Janvier 2024

You know what ? I'm happy : j'ai trouvé une parade.

eric72 à dit:
et pourtant il semble que tu es proche de la vérité

A moins qu'elle soit ailleurs, Mulder.

TooFatBoy · 29 Janvier 2024

Voici la macro qui a l'air de fonctionner. A tester...

VB:

Sub Copier_Valeurs()
' Modification/ajout des données du tableau source dans le tableau cible
Dim LigneSource As Long, LigneCible As Long
Dim MaValeur As String
Dim MaPlageDeRecherche As Range, MaCelluleTrouvee As Range

    Application.ScreenUpdating = False

    For LigneSource = 1 To Range("TbOrigine").ListObject.ListRows.Count

        MaValeur = Range("TbOrigine[Référence Devis]")(LigneSource).Value
        Set MaPlageDeRecherche = Range("TbDestination[Référence Devis]")
        Set MaCelluleTrouvee = MaPlageDeRecherche.Find(What:=MaValeur, LookIn:=xlValues, LookAt:=xlWhole)

        If MaCelluleTrouvee Is Nothing Then
            Range("TbDestination").ListObject.ListRows.Add
            LigneCible = Range("TbDestination").ListObject.ListRows.Count
        Else
            LigneCible = MaCelluleTrouvee.Row - Range("TbDestination[#headers]").Row
        End If

        Range("TbDestination[[Référence Devis]:[Téléphone]]").Rows(LigneCible).Value = Range("TbOrigine[[Référence Devis]:[Téléphone]]").Rows(LigneSource).Value
        Range("TbDestination[[Date Pose Annoncée]:[1er Acompte 40%]]").Rows(LigneCible).Value = Range("TbOrigine[[Date Pose Annoncée]:[1er Acompte 40%]]").Rows(LigneSource).Value

    Next LigneSource

End Sub

eric72 · 29 Janvier 2024

TooFatBoy à dit:

Voici la macro qui a l'air de fonctionner. A tester...

VB:

Sub Copier_Valeurs()
' Modification/ajout des données du tableau source dans le tableau cible
Dim LigneSource As Long, LigneCible As Long
Dim MaValeur As String
Dim MaPlageDeRecherche As Range, MaCelluleTrouvee As Range

    Application.ScreenUpdating = False

    For LigneSource = 1 To Range("TbOrigine").ListObject.ListRows.Count

        MaValeur = Range("TbOrigine[Référence Devis]")(LigneSource).Value
        Set MaPlageDeRecherche = Range("TbDestination[Référence Devis]")
        Set MaCelluleTrouvee = MaPlageDeRecherche.Find(What:=MaValeur, LookIn:=xlValues, LookAt:=xlWhole)

        If MaCelluleTrouvee Is Nothing Then
            Range("TbDestination").ListObject.ListRows.Add
            LigneCible = Range("TbDestination").ListObject.ListRows.Count
        Else
            LigneCible = MaCelluleTrouvee.Row - Range("TbDestination[#headers]").Row
        End If

        Range("TbDestination[[Référence Devis]:[Téléphone]]").Rows(LigneCible).Value = Range("TbOrigine[[Référence Devis]:[Téléphone]]").Rows(LigneSource).Value
        Range("TbDestination[[Date Pose Annoncée]:[1er Acompte 40%]]").Rows(LigneCible).Value = Range("TbOrigine[[Date Pose Annoncée]:[1er Acompte 40%]]").Rows(LigneSource).Value

    Next LigneSource

End Sub

je veux tester plus en détail demain matin mais en effet ça fonctione, you're the champion
Merci merci et encore merci
Tu as mérité un petit apéro.
Bonne soirée

TooFatBoy · 29 Janvier 2024

eric72 à dit:
je veux tester plus en détail demain matin mais en effet ça fonctione

En revanche, ça n'utilise pas le .Resize demandé à l'origine.
Ca convient quand même ?

eric72 à dit:
Tu as mérité un ~~petit~~ apéro.

Ah ! Trop cool ! Merci.
A notre notre bonne santé !!!

Phil69970 · 29 Janvier 2024

@eric72

A la bourre car absent cet après midi
Je te propose ce fichier

eric72 · 30 Janvier 2024

TooFatBoy à dit:
En revanche, ça n'utilise pas le .Resize demandé à l'origine.
Ca convient quand même ?

Ah ! Trop cool ! Merci.
A notre notre bonne santé !!!

Phil69970 à dit:
@eric72

A la bourre car absent cet après midi
Je te propose ce fichier

Bonjour Phil,
Pas grave pour le retard, c'est déjà bien sympa de m'aider.
Par contre cela ne fonctionne pas bien , cela ajoute les lignes.
- quand on fait une modif dans Origine cela ne modifie pas la ligne existante mais ça l'ajoute.
Toofatboy a trouvé la bonne formule alors ne t'inquiète pas.
Merci 1000 fois pour tout le boulot fourni et bonne journée.

Phil69970 · 30 Janvier 2024

@eric72

eric72 à dit:
Par contre cela ne fonctionne pas bien , cela ajoute les lignes.
- quand on fait une modif dans Origine cela ne modifie pas la ligne existante mais ça l'ajoute.

Tu es sur de ça ??

Car avec les tests que j'ai fait :
==> une ligne est rajouté seulement si la Ref_Devis est modifié ou si c'est une nouvelle ref_ Devis dans tous les autres cas de modification la ligne est juste remplacé

Par contre il est possible que les lignes dans la feuille destination ne soit plus dans le même ordre

Microsoft 365 copier coller Resize

eric72

XLDnaute Accro

Pièces jointes

TooFatBoy

eric72

XLDnaute Accro

TooFatBoy

XLDnaute Barbatruc

eric72

XLDnaute Accro

TooFatBoy

XLDnaute Barbatruc

eric72

XLDnaute Accro

TooFatBoy

XLDnaute Barbatruc

TooFatBoy

XLDnaute Barbatruc

Pièces jointes

eric72

XLDnaute Accro

TooFatBoy

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

Pièces jointes

eric72

XLDnaute Accro

Phil69970

XLDnaute Barbatruc

Discussions similaires