Explorer et transférer des données

[degap05]

Bonjour,

En adaptant (partiellement) une proposition du forum, j'ai besoin de votre aide pour compléter ce que je souhaite.

Je souhaite copier une feuille de mon classeur de travail, sans code et sans bouton, dans un classeur choisi par l'explorateur de fichier (en place).

La feuille gardera son nom.

Chaque copie écrasera la dernière.

Merci.

 

[skoobi]

Re : Explorer et transférer des données

Bonjour,

je te propose ce code pour l'USF:

Option Explicit
Dim Wb_dest As Workbook
Private Sub CommandButton1_Click()
   Dim fichier
    ChDrive "I:"
    ChDir "I:\Mes documents\Notes"
    fichier = Application.GetOpenFilename("Tous fichiers (*.*), *.*")
    'fichier = Application.GetOpenFilename("Word fichiers (*.doc), *.doc")
    'fichier = Application.GetOpenFilename("Excel fichiers (*.xls), *.xls")
    If fichier <> False Then
[COLOR=Blue][B]   'arrêt en attente de validation par bouton 3[/B][/COLOR]
      Set Wb_dest = Workbooks.Open(fichier)
      ThisWorkbook.Activate
    
    Else: MsgBox "Vous n'avez pas sélectionné de fichier ", vbOKOnly, "Explorateur de fichiers"
    End If
    
End Sub

Private Sub CommandButton3_Click()
Cells.Copy Wb_dest.Sheets(1).[A1]
With Wb_dest
  .Save
  .Close
End With
'après avoir sélectionné le fichier, copier la feuille "Toto" sans code et sans bouton
'dans celui-ci,le sauvegarder et le fermer
Unload Me
End Sub

Private Sub CommandButton4_Click()
'abandon
Unload Me
End Sub

Que veux-tu dire par ce que j'ai indiqué en bleu?
La solution convient peut-être.

 

[degap05]

Re : Explorer et transférer des données

Bonjour,

je te propose ce code pour l'USF:

Option Explicit
Dim Wb_dest As Workbook
Private Sub CommandButton1_Click()
   Dim fichier
    ChDrive "I:"
    ChDir "I:\Mes documents\Notes"
    fichier = Application.GetOpenFilename("Tous fichiers (*.*), *.*")
    'fichier = Application.GetOpenFilename("Word fichiers (*.doc), *.doc")
    'fichier = Application.GetOpenFilename("Excel fichiers (*.xls), *.xls")
    If fichier <> False Then
[COLOR=Blue][B]   'arrêt en attente de validation par bouton 3[/B][/COLOR]
      Set Wb_dest = Workbooks.Open(fichier)
      ThisWorkbook.Activate
    
    Else: MsgBox "Vous n'avez pas sélectionné de fichier ", vbOKOnly, "Explorateur de fichiers"
    End If
    
End Sub

Private Sub CommandButton3_Click()
Cells.Copy Wb_dest.Sheets(1).[A1]
With Wb_dest
  .Save
  .Close
End With
'après avoir sélectionné le fichier, copier la feuille "Toto" sans code et sans bouton
'dans celui-ci,le sauvegarder et le fermer
Unload Me
End Sub

Private Sub CommandButton4_Click()
'abandon
Unload Me
End Sub

Que veux-tu dire par ce que j'ai indiqué en bleu?
La solution convient peut-être.

Bonjour, Skoobi, ta solution me convient parfaitement.
J'ai juste ajouté:

Else: MsgBox "Vous n'avez pas sélectionné de fichier ", vbOKOnly, "Explorateur de fichiers"
Unload Me
End If

'abandon
With Wb_dest 'ferme le classeur destination
.Close
End With
Unload Me

Merci pour ton aide