Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Transférer des données d'un classeur à autre

Transférer des données d'un classeur à autre

6 réponses
Avatar
Apitos
Bonsoir,

J'ai deux classeurs :

Octobre.xls et Syth=E8se.xls

J'ai besoin de transf=E9rer les donn=E9es des colonnes A, B et C de Feuil1
du classeur Octobre dans un tableau selon le mois en cours dans le
classeur Synth=E8se, tout en mettant =E0 jour la liste S1 dans la colonne
A,

Dans mon exemple, il faut ajouter dans S1 les =E9l=E9ments BH et 2Y,

Les deux fichiers en pi=E8ces jointes.

Octobre : http://cjoint.com/?kxvdpSGRlM
Synth=E8se : http://cjoint.com/?kxvfTEpHXU

Merci d'avance.
Signaler un problème avec ce contenu

6 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Youky
Salut,
En formule c'est possible
En I2 de synthèse mets cette formule si les2 classeurs sont dans le m^me
répertoire
=[octobre.xls]Feuil1!$B$2
autre truc pour que le chemin et formule se mettent tout seul, ouvre les 2
classeurs
en I2 de synthese tu mets = et clique et clique sur B2 d'Octobre valide par
1 clic sur le V vert (à coté de barre de formule)
Ferme Octobre comme ceci le chemin se fait tout seul.
Cela restera plus simple qu'une macro.
Pour éviter d'avoir des "0" si pas de données faire ceci..
=si([octobre.xls]Feuil1!$B$2)=0;"";[octobre.xls]Feuil1!$B$2)
Youky

"Apitos" a écrit dans le message de news:

Bonsoir,

J'ai deux classeurs :

Octobre.xls et Sythèse.xls

J'ai besoin de transférer les données des colonnes A, B et C de Feuil1
du classeur Octobre dans un tableau selon le mois en cours dans le
classeur Synthèse, tout en mettant à jour la liste S1 dans la colonne
A,

Dans mon exemple, il faut ajouter dans S1 les éléments BH et 2Y,

Les deux fichiers en pièces jointes.

Octobre : http://cjoint.com/?kxvdpSGRlM
Synthèse : http://cjoint.com/?kxvfTEpHXU

Merci d'avance.
Avatar
Apitos
Bonjour Youky,

Le problème qui ce pose, c'est que la liste en A, B et C dans Octobre
change quotidiennement et vient s'ajouter en S1 des nouvelles valeurs
ainsi que leurs valeurs respectives dans S2 et S3.
Avatar
Apitos
Salut à tous,

J'ai reçu ce code de skoobi :

--------------------------------------------------------------------------- ----
Private Sub CommandButton1_Click()
Dim S1 As Range, i As Range, j As Range
m = Workbooks(2).Name
mois = Left(m, Len(m) - 4)
Set j = Cells.Find(mois, LookIn:=xlValues)
If Not j Is Nothing Then
colonne = j.Column
With Workbooks(2).Sheets(1)
For Each S1
In .Range(.Range("a2"), .Range("a2").End(xlDown))
Set i = Range(Range("a3"),
Range("a3").End(xlDown)).Find(S1, LookIn:=xlValues)
If Not i Is Nothing Then
ligne = i.Row
S1.Offset(0, 1).Copy
Cells(ligne, colonne).PasteSpecial
Paste:=xlPasteValues
S1.Offset(0, 2).Copy
Cells(ligne, colonne + 1).PasteSpecial
Paste:=xlPasteValues
Else
Range("a3").End(xlDown).Offset(1, 0).Value =
S1.Value
ligne = Range("a3").End(xlDown).Row
S1.Offset(0, 1).Copy
Cells(ligne, colonne).PasteSpecial
Paste:=xlPasteValues
S1.Offset(0, 2).Copy
Cells(ligne, colonne + 1).PasteSpecial
Paste:=xlPasteValues
End If
Next
End With
End If
Application.CutCopyMode = False
Range("A3:J40").Sort [A3], xlAscending, , , , , , xlNo
End Sub
--------------------------------------------------------------------------- -------

Mais si le test parvient à cette ligne :
--------------------------------------------------------------------------- -------
Else
Range("a3").End(xlDown).Offset(1, 0).Value =
S1.Value
--------------------------------------------------------------------------- ------

Cette erreur est signalée :

Erreur d'éxécution '1004':
Erreur définie par l'application ou par l'objet.

Je crois que l'erreur provient du fait qu'on veut effacer la valeur
contenu dans A3 par la valeur continue dans A2.

Merci de votre aide.
Avatar
Apitos
Salut,

J'ai obtenu le code suivant de skoobi :

--------------------------------------------------------------------------- ---
Private Sub CommandButton1_Click()
Dim S1 As Range, i As Range, j As Range
m = Workbooks(2).Name
mois = Left(m, Len(m) - 4)
Set j = Cells.Find(mois, LookIn:=xlValues)
If Not j Is Nothing Then
colonne = j.Column
With Workbooks(2).Sheets(1)
For Each S1
In .Range(.Range("a2"), .Range("a2").End(xlDown))
Set i = Range(Range("a3"),
Range("a3").End(xlDown)).Find(S1, LookIn:=xlValues)
If Not i Is Nothing Then
ligne = i.Row
S1.Offset(0, 1).Copy
Cells(ligne, colonne).PasteSpecial
Paste:=xlPasteValues
S1.Offset(0, 2).Copy
Cells(ligne, colonne + 1).PasteSpecial
Paste:=xlPasteValues
Else
Range("a3").End(xlDown).Offset(1, 0).Value =
S1.Value
ligne = Range("a3").End(xlDown).Row
S1.Offset(0, 1).Copy
Cells(ligne, colonne).PasteSpecial
Paste:=xlPasteValues
S1.Offset(0, 2).Copy
Cells(ligne, colonne + 1).PasteSpecial
Paste:=xlPasteValues
End If
Next
End With
End If
Application.CutCopyMode = False
Range("A3:J40").Sort [A3], xlAscending, , , , , , xlNo
End Sub
--------------------------------------------------------------------------- ----------

mais si le test passe dans cette ligne :

Else
Range("a3").End(xlDown).Offset(1, 0).Value =
S1.Value

Cette erreur est signalée :

Erreur d'éxécution '1004':
Erreur définie par l'application ou par l'objet.

Je crois que l'erreur provient du fait qu'on veut effacer la valeur
contenu dans A3 par la valeur continue dans A2.

Merci de votre aide.
Avatar
Youky
Mais si le test parvient à cette ligne :
----------------------------------------------------------------------------------
Else
Range("a3").End(xlDown).Offset(1, 0).Value =S1.Value

Mets "a1" au lieu de "a3" dans le Range(.........
Désolé pour le retard
Youky

"Apitos" a écrit dans le message de news:

Salut à tous,

J'ai reçu ce code de skoobi :

-------------------------------------------------------------------------------
Private Sub CommandButton1_Click()
Dim S1 As Range, i As Range, j As Range
m = Workbooks(2).Name
mois = Left(m, Len(m) - 4)
Set j = Cells.Find(mois, LookIn:=xlValues)
If Not j Is Nothing Then
colonne = j.Column
With Workbooks(2).Sheets(1)
For Each S1
In .Range(.Range("a2"), .Range("a2").End(xlDown))
Set i = Range(Range("a3"),
Range("a3").End(xlDown)).Find(S1, LookIn:=xlValues)
If Not i Is Nothing Then
ligne = i.Row
S1.Offset(0, 1).Copy
Cells(ligne, colonne).PasteSpecial
Paste:=xlPasteValues
S1.Offset(0, 2).Copy
Cells(ligne, colonne + 1).PasteSpecial
Paste:=xlPasteValues
Else
Range("a3").End(xlDown).Offset(1, 0).Value S1.Value
ligne = Range("a3").End(xlDown).Row
S1.Offset(0, 1).Copy
Cells(ligne, colonne).PasteSpecial
Paste:=xlPasteValues
S1.Offset(0, 2).Copy
Cells(ligne, colonne + 1).PasteSpecial
Paste:=xlPasteValues
End If
Next
End With
End If
Application.CutCopyMode = False
Range("A3:J40").Sort [A3], xlAscending, , , , , , xlNo
End Sub
----------------------------------------------------------------------------------

Mais si le test parvient à cette ligne :
----------------------------------------------------------------------------------
Else
Range("a3").End(xlDown).Offset(1, 0).Value S1.Value
---------------------------------------------------------------------------------

Cette erreur est signalée :

Erreur d'éxécution '1004':
Erreur définie par l'application ou par l'objet.

Je crois que l'erreur provient du fait qu'on veut effacer la valeur
contenu dans A3 par la valeur continue dans A2.

Merci de votre aide.
Avatar
Apitos
Salut Youky,

Entre-temps j'ai un peu modifié le code et ça marche.

Merci.