Envoie des données un fichier à un autre Fichier - VBA

Bonsoir à tous et au forum.

J'ai besoin d'aide pour envoyer des données d'un fichier AA onglet source à un fichier BB onglet destination.

Voici mon code :

Sub Envoi()
Dim sh1 As Object, sh2 As Object, rw2 As Long

Set sh1 = Windows("AA.xlsm").Activate.Sheets("Source")
Set sh2 = Windows("BB.xlsm").Activate.Sheets("Destination")

sh2.Range(rw2, "A1").Value = sh1.Range(Cell.Range, "A1")
sh2.Range(rw2, "B1").Value = sh1.Range(Cell.Range, "C1")

End
End Sub

Merci pour aide

Bonjour,

Voici une adaptation en fonction de ce que j'ai compris de votre code, en supposant que les 2 classeurs sont ouverts simultanément.

Sub Envoi()

Dim WsSource As Worksheet, WsDest As Worksheet

Set WsSource = Workbooks("AA.xlsm").Sheets("Source")
Set WsDest = Workbooks("BB.xlsm").Sheets("Destination")

WsDest.Range("A1").Value = WsSource.Range("A1").value
WsDest.Range("B1").Value = WsSource.Range("C1").value

Set WsSource = nothing
Set WsDest = nothing

End Sub

Cordialement,

Bonjour 3GB,
Merci beaucoup c'est exactement cela.
Par contre si le fichier BB/destination est fermé peut-on l'ouvrir en code vba ?

Merci

Bonjour,

Oui, c'est possible :

Sub Envoi()

Dim WbSource as Workbook, WbDest as Workbook
Dim WsSource As Worksheet, WsDest As Worksheet

Set WbSource = Workbooks("AA.xlsm")
Set WbDest = Workbooks("BB.xlsm")

Workbooks.open WbDest.Name 'Ouverture du classeur BB

Set WsSource = WbSource.Sheets("Source")
Set WsDest = WbDest.Sheets("Destination")

WsDest.Range("A1").Value = WsSource.Range("A1").value
WsDest.Range("B1").Value = WsSource.Range("C1").value

WbDest.Close Savechanges:=True 'fermeture du classeur BB avec sauvegarde

Set WsSource = nothing
Set WsDest = nothing
Set WbSource = nothing
Set WbDest = nothing

End Sub

Il est possible de désactiver les lignes ouverture et fermeture en les passant en commentaires (c'est-à-dire en ajoutant une apostrophe en début de ligne).

Cordialement,

Bonjour et encore Merci,
Finalement je vais opter pour la 1er solution :

Sub Envoi() Dim WsSource As Worksheet, WsDest As Worksheet
Set WsSource = Workbooks("AA.xlsm").Sheets("Source")
Set WsDest = Workbooks("BB.xlsm").Sheets("Destination")
WsDest.Range("A1").Value = WsSource.Range("A1").value (Cellule Active en source)
WsDest.Range("B1").Value = WsSource.Range("C1").value (Sur la même ligne que la Cellule Active en Source valeur sur la colonne F)
Set WsSource = nothing
Set WsDest = nothing End Sub

Par contre je souhaiterai faire en fonction de la cellule active en source,
C'est dire lorsque je positionne le curseur sur une cellule de la colonne A du fichier Source qu'il renvoie automatique au fichier destination
dans les cellules correspondante (en A1_Destination) + une autre valeur de la même mais en colonne F (en C1_Destination)

Merci pour ton Aide, j'éspère avoir été clair

Bonjour,

Alors, cette fois-ci, je ne suis pas certain du résultat. Il faudrait peut-être corriger un ou deux trucs.

Il faut saisir la macro évènementielle dans le module de la feuille "Source" et la macro appelée lors du double clic dans un module normal.

'CODE A PLACER DANS MODULE DE FEUILLE "Source" DU CLASSEUR "AA.xlsm"
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("A:A")) is nothing Then
        Call Envoi(Target) 'lance la procédure quand double clic sur cellule en A
        Target.Offset(1, 0).Select 'sélectionne la cellule suivante
        Msgbox "Envoi OK" 'petit message de confirmation
    end if
End Sub

'CODE A PLACER DANS UN MODULE QUELCONQUE DU CLASSEUR "AA"
Sub Envoi(CelluleCliquee as range)

Dim WsDest As Worksheet
Dim AdrCell$

Set WsDest = Workbooks("BB.xlsm").Sheets("Destination")
AdrCell = CelluleCliquee.address 'adresse de la cellule cliquée en source

WsDest.Range(AdrCell).Value = CelluleCliquee.value 'feuille destination prend valeur cellule cliquée en source (à la même adresse)
WsDest.Range(AdrCell).offset(0,2).Value = CelluleCliquee.offset(0,5).value 'colonne C destination prend valeur colonne F source

Set WsDest = nothing

End Sub

Crodialement,

Cela ne fonctionne pas

Et sans passé par le double clique ?

Vous avez essayé au moins ? Parce que d'habitude, quand des gens en sollicitent d'autres pour modifier ceci puis modifier cela et qu'ils se retrouvent avec une erreur, ils s'investissent un minimum et reviennent avec la ligne d'erreur, le message d'erreur, des captures d'écran...

En tout cas, pour ma part, je n'avance pas à l'aveugle.

Et ce que vous demandez n'est à ma connaissance réalisable qu'au moyen d'une macro double-clic.

Bonjour,
Oui j'ai essayé.

Ci-joint les 2 fichiers.

Merci

Re Bonjour,

Erreur trouvé cela fonctionne merci Bien

Par contre si le fichier BB n'est pas ouvert peut-on avoir un message

"Ouvrir le Fichier BB"

Bonne Journée

Bonjour,

Alors, je pense que ce serait mieux d'ouvrir automatiquement le classeur plutôt que d'avoir un message. Pouvez-vous essayer ce code :

Sub Envoi(CelluleCliquee as range)

Dim WbDest as Workbook
Dim WsDest As Worksheet
Dim AdrCell$

Set WbDest = Workbooks("BB.xlsm")

On error Goto PasserOuverture 'saute l'ouverture si classeur déjà ouvert
Workbooks.open WbDest.Name

PasserOuverture: 'reprise du code après erreur

Set WsDest = WbDest.Sheets("Destination")

AdrCell = CelluleCliquee.address 'adresse de la cellule cliquée en source

WsDest.Range(AdrCell).Value = CelluleCliquee.value 'feuille destination prend valeur cellule cliquée en source (à la même adresse)
WsDest.Range(AdrCell).offset(0,2).Value = CelluleCliquee.offset(0,5).value 'colonne C destination prend valeur colonne F source

If Msgbox("Voulez-vous fermer le classeur [BB.xlsm] ?",VbYesNo,"Demande de confirmation") = VbYes Then
    WbDest.close savechanges:=True
end if

Set WsDest = nothing
Set WbDest = Nothing

End Sub

J'ai cependant rajouté un message de confirmation afin que vous puissiez décider de fermer ou non le classeur BB en fin de procédure.

Si jamais le code bug quand le fichier est déjà ouvert, on adaptera avec une autre solution.

Cordialement,

Bonsoir,

Par contre le fichier BB

ce trouve sur un disk externe :

D:\Presta\BB.xlsm

comment mettre le lien ?

Set WbDest = Workbooks("D:\Presta\BB.xlsm")

Bonsoir 3GB,

classeur BB Fermer

et lorsque je fais le double click, le fichier AA

j'ai un code erreur 9 execution l'indice n'appartient pas à la selection

Et je n'ai pas encore mis l'adresse exact du fichier dans le code : Set WbDest = Workbooks("D:\Presta\BB.xlsm")

Merci

Bonsoir 3GB,

Avez-vous une solution ?

Merci

Bonsoir Man,

Avez-vous mis l'adresse exacte finalement ?

Comme je vous ai dit, si je ne sais pas sur quelle ligne se trouve l'erreur, je ne peux pas faire grand-chose...

Bonjour 3GB,

Oui j'ai mis l'adresse du fichier, qu'il soit sur le bureau ou à l'adresse exact j'ai la même message d'erreur :

Voici les 2 fichiers pour faire le test:

Bonjour Man,

Ton fichier ne serait pas nommé "bb.xlsm" par hasard ?

Sinon, peux-tu ajouter ces lignes dans un module du fichier BB :

Sub test()

Dim p$
p = thisworkbook.path & "\"
msgbox p

end sub

Je m'attendais pas à un bug sur cette ligne. Celles qui m'intéressent sont surtout les 2 suivantes...

Après petite réflexion, je ne suis pas sûr qu'on puisse ouvrir le fichier de cette manière. Je t'avais fait une proposition de code avec cette méthode et tu m'avais répondu sans manifester d'erreur particulière, mais sans confirmer pour autant que tu l'avais testé avec succès. C'était d'ailleurs l'objet de mon agacement...
Il est donc probable que tu n'aies pas tester ce code et que ça m'ait induit en erreur.

Peux-tu essayer de la sorte, en ajoutant à la ligne NomBB le résultat que tu obtiendras suite à l'essai que je t'ai conseillé de faire sur mon précédent commentaire ?

Sub Envoi(CelluleCliquee as range)

Dim NomBB$
Dim WbDest as Workbook
Dim WsDest As Worksheet
Dim AdrCell$

NomBB = "BB.xlsm"

On error Goto PasserOuverture 'saute l'ouverture si classeur déjà ouvert
Workbooks.open NomBB

PasserOuverture: 'reprise du code après erreur

Set WbDest = Workbooks(NomBB)
Set WsDest = WbDest.Sheets("Destination")

AdrCell = CelluleCliquee.address 'adresse de la cellule cliquée en source

WsDest.Range(AdrCell).Value = CelluleCliquee.value 'feuille destination prend valeur cellule cliquée en source (à la même adresse)
WsDest.Range(AdrCell).offset(0,2).Value = CelluleCliquee.offset(0,5).value 'colonne C destination prend valeur colonne F source

If Msgbox("Voulez-vous fermer le classeur [BB.xlsm] ?",VbYesNo,"Demande de confirmation") = VbYes Then
    WbDest.close savechanges:=True
end if

Set WsDest = nothing
Set WbDest = Nothing

End Sub

Bonsoir 3GB,

j'ai mis ce code et ça fonctionne :

Par contre je sais pas si celui-ci est bien optimisé mais pour le le moment ça va et merci encore pour ton aide

'CODE A PLACER DANS UN MODULE QUELCONQUE DU CLASSEUR "AA"
Sub Envoi(CelluleCliquee As Range)

Dim WsDest As Worksheet
Dim AdrCell$
Dim NomFichier As String
' affectation des variables ' C:\Users\GG\Desktop
NomFichier = VBA.FileSystem.Dir("C:\Users\GGDesktop\BB.xls?")


'test le fichier existant, si oui ouvre le fichier
If NomFichier = VBA.Constants.vbNullString Then
MsgBox "Le fichier n'est pas présent"
End


Else
Workbooks.Open "C:\Users\GG\Desktop\" & NomFichier
End If

Set WsDest = Workbooks("BB.xlsm").Sheets("Destination")
AdrCell = CelluleCliquee.Address 'adresse de la cellule cliquée en source

WsDest.Range(AdrCell).Value = CelluleCliquee.Value 'feuille destination prend valeur cellule cliquée en source (à la même adresse)
WsDest.Range(AdrCell).Offset(0, 2).Value = CelluleCliquee.Offset(0, 5).Value 'colonne C destination prend valeur colonne F source

Set WsDest = Nothing

End Sub