XL 2016 Copier coller entre deux classeurs

I

INFINITY100

XLDnaute Occasionnel
Bonjour à vous tous

Voila je reviens vers vous afin de trouver la solution à mon petit problème, car dans le classeur "Ma Facture.xlsm" j'ai un code qui fonctionne à merveille en envoyant chacune des données de la facture vers la feuille adéquate par rapport au critère choisit dans la cellule (W10) ... jusque là tout va bien.

Mon seule soucis c'est que je veux faire de même, mais envoyant ces données vers un autre classeur après ouverture à savoir "Mon Tableau de bord.xlsm" tout en gardant la même procédure de copie

Macro de copie de données :

VB: 
Dim sh As Worksheet
Dim sFormula1 As String
Dim sFormula2 As String
Dim DernierID As Integer
Dim lignevide As Integer
Dim MonApplication As Object
Dim MonTBdeBord As String
 
Sub Copier_Coller(Feuille As String, CopyRange As String)
 
   Set MonApplication = CreateObject("Shell.Application")
 
   MonTBdeBord = "C:\Users\INFINITY\Desktop\Mon-Dossier\Mon Tableau de bord.xlsm" 'à remplacer par le chemin du fichier
   MonApplication.Open (MonTBdeBord)
 
   Set MonApplication = Nothing
 
    With Worksheets(Feuille).Range("AJ68")
        If .Value Like "*CFA*" Then
            Set sh = Sheets("1-CFA")
 
        ElseIf .Value Like "*UREA*" Then
            Set sh = Sheets("2-UREA")
         Else
            Set sh = Sheets("3-UFI")
         End If
    End With
    DernierID = WorksheetFunction.Max(sh.Range("B:B"))
    lignevide = sh.Range("B" & Rows.Count).End(xlUp).Row + 1
 If lignevide < 3 Then lignevide = 3
    sh.Cells(lignevide, 2) = DernierID + 1
    sh.Range("C" & lignevide).Resize(, Sheets(Feuille).Range(CopyRange).Count) = Application.Transpose(Range(CopyRange))
    sFormula1 = "=SIERREUR(SOMME($H$" & lignevide & "*$I$" & lignevide & ");""Attention ! il y a une erreur !"")"
    sFormula2 = "=SIERREUR(SOMME($J$" & lignevide & ":$K$" & lignevide & ");""Attention ! il y a une erreur !"")"
    sh.Cells(lignevide, "J").FormulaLocal = sFormula1
    sh.Cells(lignevide, "L").FormulaLocal = sFormula2
End Sub

Pour l'appel :

VB: 
Sub Validation()
    Copier_Coller "Devis N° 100-2023 DT 1002-2023", "AJ65: AJ76"
End Sub

Je joins mes deux fichiers

Merci à vous tous

Cordialement ;)
 

Pièces jointes

  • Ma Facture.xlsm
    32.6 KB · Affichages: 6
  • Mon Tableau de bord.xlsm
    24.7 KB · Affichages: 3
Dernière édition:
Trier par date Trier par votes
fanch55

fanch55

XLDnaute Barbatruc
Bonjour,
Une proposition possible :
VB: 
Option Explicit
Sub Validation()
    ThisWorkbook.Worksheets("Devis N° 100-2023 DT 1002-2023").Activate
    Copier_Coller [AJ65: AJ76], [Aj68], ThisWorkbook
    Copier_Coller [AJ65: AJ76], [Aj68], Workbooks.Open(ThisWorkbook.Path & "\Mon Tableau de bord.xlsm")
End Sub
Sub Copier_Coller(Plage As Range, Crit As String, Wb As Workbook)
    Dim Last As Variant, Sh As Worksheet
    With Wb
        Select Case True
            Case Crit Like "*CFA*":     Set Sh = .Sheets("1-CFA")
            Case Crit Like "*UREA*":    Set Sh = .Sheets("2-UREA")
            Case Crit Like "*UFI*":     Set Sh = .Sheets("2-UFI")
            Case Else:                  Exit Sub
        End Select
    End With
    With Sh
        Last = WorksheetFunction.Max(.Cells(.Rows.Count, "B").End(xlUp).Row + 1, 3)
        .Cells(Last, "B") = WorksheetFunction.Max(.Range("B:B")) + 1
        .Cells(Last, "C").Resize(, Plage.Count) = Application.Transpose(Plage)
        .Cells(Last, "J").FormulaLocal = "=SIERREUR(SOMME($H$" & Last & "*$I$" & Last & ");""Attention ! il y a une erreur !"")"
        .Cells(Last, "L").FormulaLocal = "=SIERREUR(SOMME($J$" & Last & ":$K$" & Last & ");""Attention ! il y a une erreur !"")"
    End With
End Sub
 
Vote positif 0 Vote négatif
I

INFINITY100

XLDnaute Occasionnel
Merci beaucoup monsieur FRANCH55

Votre solution répond parfaitement à mes besoins et voir même plus car tu l'a beaucoup amélioré :)

Seulement je voudrais ajouter deux petites choses à ce code. ;)

En effet je voudrais qu'à l'ouverture du document "Mon Tableau de bord.xlsm" tester la colonne C qui contient les Numéros Des Devis de sorte que si le numéro existe alors empêcher la macro de s’exécuter avec un dialogue message avertissant l’utilisateur de cette façon : " Attention ! Ce numéro de devis existe déjà veuillez vérifier votre facture " sinon si tout va bien exécuter le code le plus normalement et à la fin un dialogue message de confirmation s'affiche de cette façon : " Les données ont été transférées dans le tableau de bord avec succès ! "

En sauvegarde les modifications
et
En ferme le classeur "Mon Tableau de bord"

Voila tout

1000 mercis encore à vous 🙏 🙏
 
Vote positif 0 Vote négatif
fanch55

fanch55

XLDnaute Barbatruc
Bonsoir,
Ce mécanisme ne concerne que "Mon Tableau de bord.xlsm" ?
J'attire votre attention que à moins de détruire manuellement la ligne correspondante auparavant, vous ne pourrez plus modifier cette facture ...

Il vaudrait peut-être mieux corriger la ligne si le devis existe .... ??? 🤔
 
Vote positif 0 Vote négatif
I

INFINITY100

XLDnaute Occasionnel
Bonsoir,
Oui ce mécanisme ne concerne que "Mon Tableau de bord.xlsm"

Car je veux juste effectuer un test avant de lancer le code que si le numéro du devis qui est dans la facture
(le 100 dans cet exemple) existe dans la colonne C du classeur cité ci-dessus alors empêcher la macro de s’exécuter avec un dialogue message

et pour ta question Il vaudrait peut-être mieux corriger la ligne si le devis existe .... ??? j'ai pas bien compris 😊
 
Vote positif 0 Vote négatif
fanch55

fanch55

XLDnaute Barbatruc
INFINITY100 à dit:
Il vaudrait peut-être mieux corriger la ligne si le devis existe .... ??? j'ai pas bien compris
Cliquez pour agrandir...
C'est à dire que si le devis existe déjà dans "Tableau de bord", on écrase cette ligne avec les données récupérées, cela évite de devoir supprimer la ligne en cas de besoin .

INFINITY100 à dit:
Oui ce mécanisme ne concerne que "Mon Tableau de bord.xlsm"
Cliquez pour agrandir...
Dans la feuille concernée de Ma facture,
on continue alors à ajouter imperturbablement la ligne à chaque fois ?

Je vous souhaite une bonne soirée, je reprendrai demain ... 😴
 
Vote positif 0 Vote négatif
I

INFINITY100

XLDnaute Occasionnel
fanch55 à dit:
C'est à dire que si le devis existe déjà dans "Tableau de bord", on écrase cette ligne avec les données récupérées, cela évite de devoir supprimer la ligne en cas de besoin .


Dans la feuille concernée de Ma facture,
on continue alors à ajouter imperturbablement la ligne à chaque fois ?

Je vous souhaite une bonne soirée, je reprendrai demain ... 😴
Cliquez pour agrandir...
Oui c'est exactement ça ce que je cherche

Merci bonne soirée à vous aussi à demain ;)
 
Vote positif 0 Vote négatif
fanch55

fanch55

XLDnaute Barbatruc
Le code ci-joint devrait le faire :
VB: 
Option Explicit
Sub Validation()
    ThisWorkbook.Worksheets("Devis N° 100-2023 DT 1002-2023").Activate
    Copier_Coller [AJ65: AJ76], [Aj68], ThisWorkbook
    Copier_Coller [AJ65: AJ76], [Aj68], Workbooks.Open(ThisWorkbook.Path & "\Mon Tableau de bord.xlsm"), Fermer:=True
    
End Sub
Sub Copier_Coller(Plage As Range, Crit As String, Wb As Workbook, Optional Fermer = False)
    Dim Ligne As Variant, Sh As Worksheet, Target As Range, State As Variant
    With Wb
        Select Case True
            Case Crit Like "*CFA*":     Set Sh = .Sheets("1-CFA")
            Case Crit Like "*UREA*":    Set Sh = .Sheets("2-UREA")
            Case Crit Like "*UFI*":     Set Sh = .Sheets("2-UFI")
            Case Else:                  Exit Sub
        End Select
    End With
    With Sh
        Ligne = WorksheetFunction.Max(.Cells(.Rows.Count, "B").End(xlUp).Row + 1, 3)
        Set Target = .Columns("C").Find(Plage(1), , xlValues, xlWhole)
        Select Case True
            Case Wb.Name = ThisWorkbook.Name: State = Empty
            Case Target Is Nothing:           State = "ajoutées"
            Case Else:                        State = "modifiées"
                                              Ligne = Target.Row
        End Select
        .Cells(Ligne, "B").FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C+1,1)"
        .Cells(Ligne, "C").Resize(, Plage.Count) = Application.Transpose(Plage)
        .Cells(Ligne, "J").FormulaLocal = "=SIERREUR(SOMME($H$" & Ligne & "*$I$" & Ligne & ");""Attention ! il y a une erreur !"")"
        .Cells(Ligne, "L").FormulaLocal = "=SIERREUR(SOMME($J$" & Ligne & ":$K$" & Ligne & ");""Attention ! il y a une erreur !"")"
    End With
    If Not IsEmpty(State) _
    Then MsgBox "Les données ont été " & State & vbLf & "dans le tableau de bord avec succès", vbExclamation, Wb.Name
    Wb.Save
    If Fermer Then Wb.Close
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
I

INFINITY100

XLDnaute Occasionnel
fanch55 à dit:
Le code ci-joint devrait le faire :
VB: 
Option Explicit
Sub Validation()
    ThisWorkbook.Worksheets("Devis N° 100-2023 DT 1002-2023").Activate
    Copier_Coller [AJ65: AJ76], [Aj68], ThisWorkbook
    Copier_Coller [AJ65: AJ76], [Aj68], Workbooks.Open(ThisWorkbook.Path & "\Mon Tableau de bord.xlsm"), Fermer:=True
 
End Sub
Sub Copier_Coller(Plage As Range, Crit As String, Wb As Workbook, Optional Fermer = False)
    Dim Ligne As Variant, Sh As Worksheet, Target As Range, State As Variant
    With Wb
        Select Case True
            Case Crit Like "*CFA*":     Set Sh = .Sheets("1-CFA")
            Case Crit Like "*UREA*":    Set Sh = .Sheets("2-UREA")
            Case Crit Like "*UFI*":     Set Sh = .Sheets("2-UFI")
            Case Else:                  Exit Sub
        End Select
    End With
    With Sh
        Ligne = WorksheetFunction.Max(.Cells(.Rows.Count, "B").End(xlUp).Row + 1, 3)
        Set Target = .Columns("C").Find(Plage(1), , xlValues, xlWhole)
        Select Case True
            Case Wb.Name = ThisWorkbook.Name: State = Empty
            Case Target Is Nothing:           State = "ajoutées"
            Case Else:                        State = "modifiées"
                                              Ligne = Target.Row
        End Select
        .Cells(Ligne, "B").FormulaR1C1 = "=IF(ISNUMBER(R[-1]C),R[-1]C+1,1)"
        .Cells(Ligne, "C").Resize(, Plage.Count) = Application.Transpose(Plage)
        .Cells(Ligne, "J").FormulaLocal = "=SIERREUR(SOMME($H$" & Ligne & "*$I$" & Ligne & ");""Attention ! il y a une erreur !"")"
        .Cells(Ligne, "L").FormulaLocal = "=SIERREUR(SOMME($J$" & Ligne & ":$K$" & Ligne & ");""Attention ! il y a une erreur !"")"
    End With
    If Not IsEmpty(State) _
    Then MsgBox "Les données ont été " & State & vbLf & "dans le tableau de bord avec succès", vbExclamation, Wb.Name
    Wb.Save
    If Fermer Then Wb.Close
End Sub
Cliquez pour agrandir...
Merci beaucoup monsieur FRANCH55

Très très aimable de votre part c'est exactement le résultat souhaité 🥰
🙏


Sauf que je voudrai bien comprendre un dernier truc : pourquoi quand je supprime par exemple la feuille 1-CFA qui se trouve dans le classeur "MA FACTURE" Excel me renvoi une erreur et cherche cette dernière hors qu'elle est bien présente dans le classeur "Mon Tableau de bord"
🤔


Nous doit-on pas lui préciser dans cette ligne du code que la Sheets est celle qui est dans le classeur "Mon Tableau de bord" ? et non celle du classeur courant c'est à dire "MA FACTURE" si oui comment la modifier ? ;)

VB: 
Case Crit Like "*CFA*":     Set Sh = .Sheets("1-CFA")
Case Crit Like "*UREA*":    Set Sh = .Sheets("2-UREA")
Case Crit Like "*UFI*":     Set Sh = .Sheets("3-UFI")
 
Vote positif 0 Vote négatif
fanch55

fanch55

XLDnaute Barbatruc
INFINITY100 à dit:
Sauf que je voudrai bien comprendre un dernier truc : pourquoi quand je supprime par exemple la feuille 1-CFA qui se trouve dans le classeur "MA FACTURE" Excel me renvoi une erreur et cherche cette dernière hors qu'elle est bien présente dans le classeur "Mon Tableau de bord"
🤔
Cliquez pour agrandir...
C'est parce qu'on demande également un "Coller" dans le classeur "Ma Facture" , c'est ce que j'avais compris au premier post .
INFINITY100 à dit:
Mon seule soucis c'est que je veux faire de même, mais envoyant ces données vers un autre classeur après ouverture à savoir "Mon Tableau de bord.xlsm" tout en gardant la même procédure de copie
Cliquez pour agrandir...

Enrichi (BBcode): 
Sub Validation()
    ThisWorkbook.Worksheets("Devis N° 100-2023 DT 1002-2023").Activate
    Copier_Coller [AJ65: AJ76], [Aj68], ThisWorkbook
    Copier_Coller [AJ65: AJ76], [Aj68], Workbooks.Open(ThisWorkbook.Path & "\Mon Tableau de bord.xlsm"), Fermer:=True
    
End Sub

Mais vous pouvez corriger cela en supprimant ou en commentant la ligne rouge .
 
Vote positif 0 Vote négatif
I

INFINITY100

XLDnaute Occasionnel
fanch55 à dit:
C'est parce qu'on demande également un "Coller" dans le classeur "Ma Facture" , c'est ce que j'avais compris au premier post .
Cliquez pour agrandir...
Non c'etait juste pour l'exemple j'aurai du le préciser😊 mais bon ....

En tout cas là je peux dire que le code est parfait et répond totalement à mes besoins grâce à vous monsieur FRANCH55

1000 mercis encore très aimable de votre part 🙏

Je joins les deux fichiers finaux pour ceux qui n'auront besoin dans l'avenir ;)
 

Pièces jointes

  • Ma Facture.xlsm
    31.4 KB · Affichages: 3
  • Mon Tableau de bord.xlsm
    24.7 KB · Affichages: 2
Vote positif 0 Vote négatif
I

INFINITY100

XLDnaute Occasionnel
fanch55 à dit:
C'est parce qu'on demande également un "Coller" dans le classeur "Ma Facture" , c'est ce que j'avais compris au premier post .


Enrichi (BBcode): 
Sub Validation()
    ThisWorkbook.Worksheets("Devis N° 100-2023 DT 1002-2023").Activate
   Copier_Coller [AJ65: AJ76], [Aj68], ThisWorkbook
    Copier_Coller [AJ65: AJ76], [Aj68], Workbooks.Open(ThisWorkbook.Path & "\Mon Tableau de bord.xlsm"), Fermer:=True
 
End Sub

Mais vous pouvez corriger cela en supprimant ou en commentant la ligne rouge .
Cliquez pour agrandir...
bonjour monsieur FRANCH55

Je reviens encore à vous pour résoudre un petit soucis dans le code

En effet en mettant le fichier en pratique je me confronte à un problème dont je ne comprend pas comment le résoudre car en insérant une nouvelle facture avec d'autres données à savoir par exemple
Devis N° 101-2023 DT 1003-2023 Excel ne prend en considération que la première facture en modifiant cette dernière indéfiniment à chaque que je clique sur le bouton.

Donc ma demande est comment modifier le code afin d'envoyer les donnée vers le tableau de bord comme il le fait mais pour chaque facture créée et non juste le Devis N° 100-2023 DT 1002-2023

Sachant que mon fichier facture sera composé de factures comme suit: Devis N° 101... Devis N° 102... Devis N° 103 etc....

Si je devine bien le problème viens d'ici (enfin je ne sais pas 😊) pour chaque feuille active et non uniquement pour la feuille "Devis N° 100-2023 DT 1002-2023"

VB: 
ThisWorkbook.Worksheets("Devis N° 100-2023 DT 1002-2023").Activate

Merci encore ;)
 
Vote positif 0 Vote négatif
fanch55

fanch55

XLDnaute Barbatruc
Bonsoir, c'est bien cette ligne .
Correction:
VB: 
Sub Validation()
    ' ThisWorkbook.Worksheets("Devis N° 100-2023 DT 1002-2023").Activate
    Copier_Coller [AJ65: AJ76], [Aj68], Workbooks.Open(ThisWorkbook.Path & "\Mon Tableau de bord.xlsm"), Fermer:=True
    
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

I
  • Question
XL 2016 Mon code VBA me renvoi une erreur
Réponses
6
Affichages
687
INFINITY100
I
I
  • Question
XL 2016 Modification d'une ligne dans mon code
Réponses
2
Affichages
580
INFINITY100
I
I
  • Question
XL 2016 Copier vers les feuilles avec condition
Réponses
4
Affichages
505
INFINITY100
I
E
  • Résolu(e)
Microsoft 365 Copier Coller selon condition
Réponses
5
Affichages
224
TooFatBoy
TooFatBoy
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
550
marie3107
M
T
  • Question
XL 2013 Copier une feuille vers divers classeurs
Réponses
2
Affichages
433
tototn
T
U
  • Résolu(e)
Autres Mettre en couleur ligne avec VBA car MFC occupées (Excel 2003)
2
Réponses
15
Affichages
1 K
un internaute
U
D
  • Question
XL 2019 Recherche chiffre avec VBA
Réponses
3
Affichages
867
damso
D
M
  • Question
XL 2016 Envoi courriel copier/coller avec mise en forme (corps couuriel)
Réponses
2
Affichages
1 K
MONTREAL2020
M
D
  • Question
XL 2010 Relation entre deux combobox et suppression d'une ligne
Réponses
3
Affichages
811
Dranreb
Dranreb

Membres actuellement en ligne

Aucun membre en ligne actuellement.
1 membres et 67 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 124
Messages
2 116 471
Membres
112 753
dernier inscrit
PUARAI29