XL 2010 importer et exporter des données à des fichiers excel

[adildetaza]

Bonjour.
Merci à tous les membres de la communauté Excel-Download. J'ai besoin de votre aide pour modifier la macro ci-dessous. Mon objectif
est de créer une macro pour importer le contenu de la celle A1 d'un autre classer vers la cellule A1 de mon fichier test-exportation. et d'exporter le contenu de la cellule A2 de mon fichier test-exportation vers la cellule A2 de l'autre classeur. Le problème de la macro que j'utilise qu'elle fonctionne bien pour importer mais ne permet pas d'exporter le contenu de la cellule A2 vers la cellule A2 de l'autre classeur. Je veux aussi que cette opération se fait ne seulement a partir un seul fichier Excel mais plusieurs. c'est-à-dire importer les données de plusieurs classeurs et non un seul classeur : importer A1 de classeur1 vers A1 de mon fichier test-exportation et A2 de mon fichier test-exportation vers A2 de classeur1. puis importer A1 de classeur2vers A1 de mon fichier test-exportation et A2 de mon fichier test-exportation vers A2 de classeur2........

'déclaration des variables
Dim ListeFicher As Variant
Dim MonClasseur As Workbook

'on désactive le presse-papier et le raffraichissement de l'écran
Application.CutCopyMode = False
Application.ScreenUpdating = False

'on efface les anciens données
ActiveSheet.Range("A1") = ""

'on récupère le fichier des données à copier
ListeFichier = Application.GetOpenFilename(Title:="Sélectionnez votre classeur", _
filefilter:="Fichiers Excel(*.xls*),*xls*", ButtonText:="Cliquez")

'prévoir le cas du bouton annuler
If ListeFichier <> False Then
'on affecte le fichier sélectionné
Set MonClasseur = Application.Workbooks.Open(ListeFichier)

'importation des données
ThisWorkbook.ActiveSheet.Range("A1").Value = MonClasseur.Sheets(1).Range("A1").Value
MonClasseur.Sheets(1).Range("A2").Value = ThisWorkbook.ActiveSheet.Range("A2").Value
'on désactive les messages d'alerte de Microsoft
Application.DisplayAlerts = False

'on ferme le classeur source
MonClasseur.Close

End If
'on ré-active le presse papier
Application.CutCopyMode = True
Application.ScreenUpdating = True

 

[fanfan38]

Bonjour
Apparemment tu importes bien les données de la cellule A2 mais tu ne sauvegarde pas

   Application.DisplayAlerts = False
   MonClasseur.Save
   MonClasseur.Close 'on ferme le classeur source
   Application.DisplayAlerts = True

A+ François

 

[patricktoulon]

bonjour a tous

Sub echange()
Dim WbK2, Fichier
    Fichier = Application.GetOpenFilename(Title:="Sélectionnez votre classeur", filefilter:="Fichiers Excel(*.xls*),*xls*", ButtonText:="Cliquez")
    If Fichier = False Then Exit Sub
    Application.ScreenUpdating = False
    Set WbK2 = Workbooks.Open(Fichier)
    ThisWorkbook.ActiveSheet.Range("A1").Value = WbK2.Sheets(1).Range("A1").Value
    WbK2.Sheets(1).Range("A2").Value = ThisWorkbook.ActiveSheet.Range("A2").Value
    WbK2.Save: WbK2.Close
End Sub

 

[adildetaza]

Bonjour
Apparemment tu importes bien les données de la cellule A2 mais tu ne sauvegarde pas

   Application.DisplayAlerts = False
   MonClasseur.Save
   MonClasseur.Close 'on ferme le classeur source
   Application.DisplayAlerts = True

A+ François

Bonjour.

Merci François. Votre solution est efficace. ça marche très bien. mais j'ai encore un problème. Mon code VBA ne me permet pas d'importer et d'exporter vers plusieurs fichiers à la fois.

 

[adildetaza]

bonjour a tous

Sub echange()
Dim WbK2, Fichier
    Fichier = Application.GetOpenFilename(Title:="Sélectionnez votre classeur", filefilter:="Fichiers Excel(*.xls*),*xls*", ButtonText:="Cliquez")
    If Fichier = False Then Exit Sub
    Application.ScreenUpdating = False
    Set WbK2 = Workbooks.Open(Fichier)
    ThisWorkbook.ActiveSheet.Range("A1").Value = WbK2.Sheets(1).Range("A1").Value
    WbK2.Sheets(1).Range("A2").Value = ThisWorkbook.ActiveSheet.Range("A2").Value
    WbK2.Save: WbK2.Close
End Sub

Bonjour.
Merci pour ton aide. ton code est efficace. Mais j'ai encore une question est-ce qu'on peut faire l'échange avec plusieurs fichiers sélectionnées au même temps. C'est-à-dire faire l'échange avec Wbk2 puis Wbk3..... Merci encore une fois

 

[job75]

Bonjour à tous,

est-ce qu'on peut faire l'échange avec plusieurs fichiers sélectionnées au même temps.

Mettez dans un Array les chemins d'accès complets des fichiers à traiter puis faites une boucle sur cet Array.

A+

 

[adildetaza]

Bonjour à tous,

Mettez dans un Array les chemins d'accès complets des fichiers à traiter puis faites une boucle sur cet Array.

A+

Bonjour.
Merci pour ton aide. En réalité j'arrive pas à faire cette modification. Est-ce que vous pouvez modifier le code. Merci encore une fois

 

[job75]

Téléchargez le fichiers joints dans le même dossier et exécutez la macro :

Sub Ellipse1_Cliquer()
Dim a(), n As Byte, valeur_A2, texte As String
ReDim a(1 To 3)
a(1) = ThisWorkbook.Path & "\Classeur1.xlsx"
a(2) = ThisWorkbook.Path & "\Classeur2.xlsx"
a(3) = ThisWorkbook.Path & "\Classeur3.xlsx"
valeur_A2 = Range("A2")
Application.ScreenUpdating = False
For n = 1 To UBound(a)
    With Workbooks.Open(a(n)).Sheets(1)
        texte = texte & " " & .Range("A1") 'concaténation
        .Range("A2") = valeur_A2
        .Parent.Close True 'enregistre et ferme le fichiet
    End With
Next
Range("A1") = Trim(texte) 'restitution en A2 des textes concaténés
End Sub

 

[adildetaza]

Téléchargez le fichiers joints dans le même dossier et exécutez la macro :

Sub Ellipse1_Cliquer()
Dim a(), n As Byte, valeur_A2, texte As String
ReDim a(1 To 3)
a(1) = ThisWorkbook.Path & "\Classeur1.xlsx"
a(2) = ThisWorkbook.Path & "\Classeur2.xlsx"
a(3) = ThisWorkbook.Path & "\Classeur3.xlsx"
valeur_A2 = Range("A2")
Application.ScreenUpdating = False
For n = 1 To UBound(a)
    With Workbooks.Open(a(n)).Sheets(1)
        texte = texte & " " & .Range("A1") 'concaténation
        .Range("A2") = valeur_A2
        .Parent.Close True 'enregistre et ferme le fichiet
    End With
Next
Range("A1") = Trim(texte) 'restitution en A2 des textes concaténés
End Sub

Bonjour.
Merci beaucoup Job. Ta proposition fonctionne très très bien. Mais il y a encore un petit problème. Les fichiers qu'on va ouvrir n'ont pas un nom précis. et même le nombre on peut ouvrir 3 ou plus. lorsqu'on apporte le contenu de la cellule A. on va effacer le contenu précédent. C'est pour ça je préfère la solution Arry

 

[job75]

Bonjour adildetaza, le fil,

Les fichiers qu'on va ouvrir n'ont pas un nom précis. et même le nombre on peut ouvrir 3 ou plus.

Alors voyez ce fichier (2) et la nouvelle macro :

Sub Ellipse1_Cliquer()
Dim chemin$, fichier$, valeur_A2, texte$
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin & "*.xls*") '1er fichier du dossier
valeur_A2 = Range("A2")
Application.ScreenUpdating = False
While fichier <> ""
    If fichier <> ThisWorkbook.Name Then
        With Workbooks.Open(chemin & fichier).Sheets(1)
            texte = texte & " " & .Range("A1") 'concaténation
            .Range("A2") = valeur_A2
            .Parent.Close True 'enregistre et ferme le fichiet
        End With
    End If
    fichier = Dir 'fichier suivant
Wend
Range("A1") = Trim(texte) 'restitution en A1 des textes concaténés
End Sub

A+