XL 2016 Copier coller entre deux classeurs

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:

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
 

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 🙏 🙏
 

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 .... ??? 🤔
 

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 😊
 

fanch55

XLDnaute Barbatruc
Il vaudrait peut-être mieux corriger la ligne si le devis existe .... ??? j'ai pas bien compris
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 .

Oui ce mécanisme ne concerne que "Mon Tableau de bord.xlsm"
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 ... 😴
 

INFINITY100

XLDnaute Occasionnel
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 ... 😴
Oui c'est exactement ça ce que je cherche

Merci bonne soirée à vous aussi à demain ;)
 

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:

INFINITY100

XLDnaute Occasionnel
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
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")
 

fanch55

XLDnaute Barbatruc
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"
🤔
C'est parce qu'on demande également un "Coller" dans le classeur "Ma Facture" , c'est ce que j'avais compris au premier post .
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

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 .
 

INFINITY100

XLDnaute Occasionnel
C'est parce qu'on demande également un "Coller" dans le classeur "Ma Facture" , c'est ce que j'avais compris au premier post .
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

INFINITY100

XLDnaute Occasionnel
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 .
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 ;)
 

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
 

Discussions similaires

Statistiques des forums

Discussions
313 243
Messages
2 096 508
Membres
106 644
dernier inscrit
7frd5