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

Le
Apitos
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.
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Youky
Le #4998481
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"
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.
Apitos
Le #4998351
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.
Apitos
Le #4998201
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.
Apitos
Le #4997981
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.
Youky
Le #4997711
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"
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.
Apitos
Le #4997661
Salut Youky,

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

Merci.
Publicité
Poster une réponse
Anonyme