XL 2016 Copier coller entre deux classeurs

INFINITY100 · 1 Mai 2023

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 😉

fanch55 · 8 Mai 2023

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 · 8 Mai 2023

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 · 8 Mai 2023

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 · 8 Mai 2023

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 · 8 Mai 2023

INFINITY100 à dit:
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 .

INFINITY100 à dit:
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 · 8 Mai 2023

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 ... 😴

Oui c'est exactement ça ce que je cherche

Merci bonne soirée à vous aussi à demain 😉

fanch55 · 9 Mai 2023

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

INFINITY100 · 9 Mai 2023

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

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 · 9 Mai 2023

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"

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

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 · 9 Mai 2023

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 .

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 😉

INFINITY100 · 11 Mai 2023

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 .

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 · 11 Mai 2023

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

INFINITY100 · 11 Mai 2023

Merci infiniment monsieur FRANCH55

Effectivement c'est tout simple 😊 qu'est ce que je suis nul en VBA 🙃

Merci encore là je peux dire mon fichier marche super bien

XL 2016 Copier coller entre deux classeurs

INFINITY100

XLDnaute Occasionnel

Pièces jointes

fanch55

XLDnaute Barbatruc

INFINITY100

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

INFINITY100

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

INFINITY100

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

INFINITY100

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

INFINITY100

XLDnaute Occasionnel

Pièces jointes

INFINITY100

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

INFINITY100

XLDnaute Occasionnel

Discussions similaires

XL 2016 Copier coller entre deux classeurs

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency