XL 2010 aide sur code VBA collationnement de données

olivier388 · 2 Mars 2023

Bonjour a tous,

Je me permet de venir vers vous car j'ai commence un code en VBA qui me permettrai de collationner des données d'un tableau pour les envoyer dans un autre classeur.
Du coup j'ai réessayer de faire mon code. la première partie a été faite avec l'enregistreur de macro...je pense qu'il est possible de l’alléger un peu mais j'avoue que pour l'instant mes connaissances sont légères sur le sujet et la seconde partie avec mes neurones un peu fatigués de "débutant"... le code fonctionne bien au début mais arrivé sur cette ligne "Set FeuilleSource = ClasseurSource.Sheets("Feuil4")" le code s'arrete et me renvoie une erreur 9. J'aurais aimé savoir comment corriger cette erreur si quelqu'un peut eclairer ma lanterne.
Merci d'avance

VB:

Sub copiercoller()
'
' copiercoller Macro
'

'
    Sheets("PJ CONVENTIONNE 4").Select
    Range("G6:J6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil4").Select
    Range("F3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PJ CONVENTIONNE 4").Select
    Range("Q6:U6").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil4").Select
    Range("G3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PJ CONVENTIONNE 4").Select
    Range("M3:X3").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil4").Select
    Range("H3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PJ CONVENTIONNE 4").Select
    ActiveWindow.ScrollWorkbookTabs Sheets:=-1
    Sheets("PLAN DE CHAMBRE").Select
    Range("I42").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.ScrollWorkbookTabs Position:=xlLast
    Sheets("Feuil4").Select
    Range("I3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PJ CONVENTIONNE 4").Select
    Range("G22:H22").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil4").Select
    Range("J3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PJ CONVENTIONNE 4").Select
    Range("C22:D22").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil4").Select
    Range("K3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PJ CONVENTIONNE 4").Select
    Range("I22:J22").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil4").Select
    Range("L3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("PJ CONVENTIONNE 4").Select
    Range("K22:L22").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil4").Select
    Range("M3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Set ClasseurCible = Workbooks.Open("C:\Users\Public\Documents\recapitulatif 2023.xlsx")
    ClasseurCible.ChangeFileAccess Mode:=xlReadWrite
    Set FeuilleSource = ClasseurSource.Sheets("Feuil4")
    Set PlageSource = FeuilleSource.Range("F3:M3")
    Set FeuilleCible = ClasseurCible.Sheets("recap")
    DerniereLigne = FeuilleCible.Cells(Rows.Count, 1).End(xlUp).Row
    PlageSource.Copy FeuilleCible.Cells(DerniereLigne + 1, 1)
    ClasseurCible.Save
    ClasseurCible.Close
    ClasseurSource.Save
    ClasseurSource.Close
End Sub

Wayki · 2 Mars 2023

Bonjour,
A quoi correspond classeursource ?
On voit classeurcible déclaré mais pas de classeursource ?
A +

sylvanu · 2 Mars 2023

Bonjour Olivier,
"ClasseurSource" n'est pas déclaré, donc le VBA ne sait pas ce que cela veut dire. Il vous manque :

Code:

Set ClasseurSource = Workbooks.Open("C:\Users\Public\Documents\xxxxxxxxxxx.xlsx")

Pour la partie copier coller, on peut simplifier :

Code:

Sub CopierColler()
Set PJ = Sheets("PJ CONVENTIONNE 4")
With Sheets("Feuil4")
    .Range("F3:I3") = PJ.Range("G6:J6").Value
    .Range("G3:K3") = PJ.Range("Q6:U6").Value
    .Range("H3:S3") = PJ.Range("M3:X3").Value
    .Range("J3:K3") = PJ.Range("G22:H22").Value
    .Range("K3:L3") = PJ.Range("C22:D22").Value
    .Range("L3:M3") = PJ.Range("I22:J22").Value
    .Range("M3:N3") = PJ.Range("K22:L22").Value
    .Range("I3") = Sheets("PLAN DE CHAMBRE").Range("I42").Value
End With
End Sub

Sauf si je n'ai pas tout bien compris, Un truc ne colle pas dans votre code :
Vous collez des plages dans d'autres plages par ex Range("G6:J6") dans F3 donc les données vont se coller en F3:I3
Puis vous collez la plage Range("Q6:U6") dans G3 donc les données vont se coller en G3:K3
donc les cellules G3:I3 seront écrasées.
idem pour la suite, vous collez respectivement en F3,G3,H3,I3,J3,K3, donc tout sera écrasé.

Ou est ce que je me trompe. 😳

olivier388 · 2 Mars 2023

Bonjour Wayki et sylvanu,
Déjà un grand merci pour vos réponses apportées.
Oui en effet je n'ai pas déclaré le "ClasseurSource" car c'est le classeur qui sera ouvert et l'endroit a partir duquel la macro sera lancée. C'est a dire que le classeur source sera déjà ouvert. Le but de cette macro, c'est de pouvoir recuperer les cellules "G6:J6,Q6:U6,M3:X3,G22:H22,C22😀22,I22:J22 et K22:L22" et de venir ainsi les coller a la suite sur une ligne "F3:M3" sur "feuil4". La macro copie ainsi cette ligne de "feuil4" et viens la coller a la suite de lignes déjà présentes sur le Classeur.cible.
J'aurais pu je pense faire un copier/coller directement sur la feuille.cible mais je n'ai pas encore toutes les connaissances de ce coté la.
Je ne sais pas si ça vous parait plus clair...
En tout cas merci sylvanu j'ai pu réadapter ton bout de code et il fonctionne bien et en plus ça fait plus présentable..🙂

sylvanu · 2 Mars 2023

Alors votre macro ne marche pas.
Je copie les cellules "G6:J6,Q6:U6,M3:X3,G22:H22,C22.D22,I22:J22 et K22:L22" ce qui fait en tout 29 cellules
Je les colle en "F3:M3" ce qui fait 8 cellules.
Ya un truc qui cloche. 🙂

En PJ un exemple pour montrer le problème.
Deux macros :
1- La votre dont le résultat est en feuille 4
2- La même sauf qui colle au fur et à mesure sur des lignes différentes.

olivier388 à dit:
il fonctionne bien et en plus ça fait plus présentable..

Surtout la maintenance et les évolutions seront bien plus simples.

olivier388 · 2 Mars 2023

Au temps pour moi....j'ai oublié de préciser que ce sont des cellules fusionnées c'est pour cela que pour certaines il y a de grosses plages copiées... donc les cellules copiées sont bien les plages de cellules "G6:J6,Q6:U6,M3:X3,I42,G22:H22,C22.D22,I22:J22 et K22:L22
Je viens de modifier votre fichier avec les fusions de cellules comme dans mon fichier. Je vous aurais bien envoyer mon classeur mais beaucoup de données sensibles....

sylvanu · 2 Mars 2023

D'où l'intérêt d'un petit fichier test. 🙂 Car ça, on ne peut pas le deviner.

Dans ce cas le code peut être simplifié. Quand on a des cellules fusionnées, le VBA voit la valeur dans la première cellule à gauche.
Donc :

VB:

.Range("F3:I3") = PJ.Range("G6:J6").Value
est équivalent à
.Range("F3") = PJ.Range("G6").Value

D'où :

Code:

Sub CopierColler()
Set PJ = Sheets("PJ CONVENTIONNE 4")
With Sheets("Feuil4")
    .Cells.ClearContents
    .Range("F3") = PJ.Range("G6").Value
    .Range("G3") = PJ.Range("Q6").Value
    .Range("H3") = PJ.Range("M3").Value
    .Range("J3") = PJ.Range("G222").Value
    .Range("K3") = PJ.Range("C22").Value
    .Range("L3") = PJ.Range("I22").Value
    .Range("M3") = PJ.Range("K22").Value
    .Range("I3") = Sheets("PLAN DE CHAMBRE").Range("I42").Value
End With
End Sub

Et tant qu'à faire de simplifier par rapport à votre macro initiale :

Code:

Sub CopierColler()
Set PJ = Sheets("PJ CONVENTIONNE 4")
With Sheets("Feuil4")
    .Cells.ClearContents
    .[F3] = PJ.[G6]
    .[G3] = PJ.[Q6]
    .[H3] = PJ.[M3]
    .[J3] = PJ.[G22]
    .[K3] = PJ.[C22]
    .[L3] = PJ.[I22]
    .[M3] = PJ.[K22]
    .[I3] = Sheets("PLAN DE CHAMBRE").[I42]
End With
End Sub

olivier388 · 2 Mars 2023

sylvanu à dit:
D'où l'intérêt d'un petit fichier test. 🙂 Car ça, on ne peut pas le deviner.

Je garde l'idée dans un coin de ma tête en effet pour la prochaine fois. En effet ça peut simplifier beaucoup de choses.
Effectivement le code est plus que simplifié. c'est impressionnant je suis passé de 7 lignes pour copier/coller une cellule a une seule ligne. merci beaucoup en tout cas.

olivier388 · 3 Mars 2023

Rebonjour,

Du coup la première partie de mon code fonctionne a merveille et j'ai réessayé de récrire la deuxième partie qui me permet de copier la ligne de "feuil4" vers mon deuxième tableau "recapitulatif2023" sur la feuille "recap". tout se passe a merveilles jusqu'a cette ligne " ClasseurDest.Sheets("recap").Range("A" & DerniereLigne).PasteSpecial (xlPasteValues)"
Celle ci me renvoie une erreur d'execution 1004 la methode PasteSpecial de la classe Range a echoué.
Il y a t'il moyen de contourner cette erreur?

VB:

'Définir la plage à copier
    Set PlageSource = ThisWorkbook.Sheets("Feuil4").Range("F3:M3")
   
    'Ouvrir le classeur de destination
    Dim Chemin As String
    Dim ClasseurDest As Workbook
   
    Chemin = "C:\Users\Public\Documents\recapitulatif 2023.xlsx"
   
    'Vérifier si le classeur est déjà ouvert
    On Error Resume Next
    Set ClasseurDest = Workbooks(Chemin)
    On Error GoTo 0
   
    'Si le classeur est déjà ouvert, activer la feuille de destination
    If Not ClasseurDest Is Nothing Then
        ClasseurDest.Activate
        DerniereLigne = ClasseurDest.Sheets("recap").Cells(Rows.Count, 1).End(xlUp).Row + 1
    Else 'Sinon, ouvrir le classeur et récupérer la dernière ligne non vide
        Set ClasseurDest = Workbooks.Open(Chemin)
        DerniereLigne = ClasseurDest.Sheets("recap").Cells(Rows.Count, 1).End(xlUp).Row + 1
    End If
   
    'Coller la plage à la suite des lignes existantes dans le classeur de destination
   ClasseurDest.Sheets("recap").Range("A" & DerniereLigne).PasteSpecial (xlPasteValues)
    Application.CutCopyMode = False
   
    'Fermer le classeur de destination en sauvegardant les modifications
    ClasseurDest.Close SaveChanges:=True
End Sub

sylvanu · 3 Mars 2023

Bonjour,
Post #7 :

sylvanu à dit:
D'où l'intérêt d'un petit fichier test. 🙂

Post #8

sylvanu à dit:
D'où l'intérêt d'un petit fichier test. 🙂

Et vous reposez une question, qui n'a rien à voir avec le titre du fil, et évidemment sans fichier test.
J'ai quand même l'impression que ... Bon, enfin....

On voit qu'à la fin de votre code, vous faites un collage :

VB:

    'Coller la plage à la suite des lignes existantes dans le classeur de destination
   ClasseurDest.Sheets("recap").Range("A" & DerniereLigne).PasteSpecial (xlPasteValues)

mais je ne vois pas où vous avez fait un Copier ?

olivier388 à dit:
Il y a t'il moyen de contourner cette erreur?

Il ne faut jamais contourner une erreur, sauf cas spécifique et bien maitrisé. Il faut en trouver l'origine et la corriger.

olivier388 · 3 Mars 2023

En effet je n'ai pas mis le fichier test...désolé. Je viens de trouver la solution, en effet il n'y avais pas la ligne avec la commande copier. je viens de la rajouter et ça fonctionne a merveille... merci beaucoup Sylvanu. Du coup je met le fichier test avec la macro qui fonctionne au poil... Vous aviez raison ne jamais contourner une erreur mais en trouver l'origine.

XL 2010 aide sur code VBA collationnement de données

olivier388

XLDnaute Nouveau

Wayki

XLDnaute Impliqué

sylvanu

XLDnaute Barbatruc

olivier388

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Pièces jointes

olivier388

XLDnaute Nouveau

Pièces jointes

sylvanu

XLDnaute Barbatruc

Pièces jointes

olivier388

XLDnaute Nouveau

olivier388

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

olivier388

XLDnaute Nouveau

Pièces jointes

Discussions similaires

XL 2010 aide sur code VBA collationnement de données

XLDnaute Nouveau

XLDnaute Impliqué

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

Discussions similaires

Privacy & Transparency

Privacy & Transparency