Tansfert de donnees entre classeurs

Bonjour,

Tu veux quelque chose comme ceci ?

'------------------------------------------
Sub test()
Dim WkSource As Workbook
Dim WkCible As Workbook
Dim Sh As Worksheet
Dim Nom As String, ValeurSource As Range
Dim ValeurCible As Range

Set WkSource = Workbooks("Classeur1")
Set WkCible = Workbooks("Classeur2")

For Each Sh In WkSource.Worksheets
Nom = Sh.Name
Set ValeurSource = Sh.Range("A65536").End(xlUp)
With WkCible.Worksheets(Nom)
Set ValeurCible = .Range("A65536").End(xlUp)
If ValeurCible <> ValeurSource Then
ValeurSource.EntireRow.Copy ValeurCible.Offset(1)
Else
MsgBox "Pour la feuille source """ & Sh.Name & """ " & _
"il n'y a aucune ligne à copier."
End If
End With
Next
End Sub
'------------------------------------------


MichD
---------------------------------------------------------------

Je veux dire BRAVO et surtout un grand Merci

c'est fantastique, qu'est ce que je peux apprendre ici

c'est dingue

en revanche si le fichier source est fermé cela ne fonctionne pas

pourtant source et cible sont dans un meme dossier

J'ai supposé que dans chacun des classeurs, le nom des onglets
des feuilles était le même...

J'ai supposé que dans chacun des classeurs, le nom des onglets

des feuilles était le même...

Bonne supposition c'est exactement ca

seulement je crois que les 2 classeurs doivent etre ouverts

| seulement je crois que les 2 classeurs doivent etre ouverts

Effectivement, c'est l'approche la plus simple!


MichD
---------------------------------------------------------------

est ce beaucoup plus complexe à mettre en oeuvre en demandant de faire la manip, avec seulement le classeur source ou cible ouvert?

| beaucoup plus complexe à mettre en oeuvre

A ) Tu copies ce qui suit dans un module standard
B ) Le classeur destination est celui dans lequel tu veux
inscrire des données si la dernière ligne en colonne A
est différente de la dernière ligne de la colonne A dans
chacune des feuilles où tu copieras cette procédure.

C ) Dans le fichier de destination, si tu veux supprimer la
dernière ligne de données, tu dois "SUPPRIMER LA LIGNE"
et pas seulement l'effacer.

D ) Dans le fichier de destination, pour chacune des feuilles,
sélectionne la première ligne et SUPPRIME LA TOTALITÉ
des lignes vides... sinon ADO va détecter la dernière où
il y a eu déjà des données et tu vas avoir des problèmes.
L'idéal serait que tu fasses la même chose avec les colonnes
vides pour la même raison.

E ) Maintenant à toi de t'amuser!

'------------------------------------------------------------
Sub Extraire_Données_Avec_ADO_Liason_Tardive()
'Liaison tardive ne requiert pas de charger la
'la bibliothèque ADO avant l'exécution de la procédure
'Microsoft Activex Data Object 2.x librairy"

Dim Cnn As Object, Rst As Object, Rg As Range
Dim ClasseurCible As String, X As Integer
Dim ConString As String, Requete As String
Dim Sh As Worksheet, FeuilleSource As String

'Chemin & nom du fichier du classeur cible
'J'ai supposé que les 2 classeurs étaient dans le même chemin
ClasseurCible = ThisWorkbook.Path & "Ado_Feuille_Destination.xlsm"

'Chaine de connection,les feuilles sont supposées
'avoir des étiquettes de colonnes, sinon tu changes
'Yes pour NO dans ce qui suit.
ConString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ClasseurCible & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";"
'Yes -> en-tête de colonne
'NO -> sans en-tête de colonne

'Création d'un objet Connection
Set Cnn = CreateObject("ADODB.Connection")
'Création d'un objet RecordSet
Set Rst = CreateObject("ADODB.Recordset")

'Ouverture de la connection à la base de donnée
Cnn.Open ConString

For Each Sh In ThisWorkbook.Worksheets
Set Rg = Sh.Range("A65536").End(xlUp)
FeuilleSource = Sh.Name
'Texte de la requête
Requete = "SELECT * FROM [" & FeuilleSource & "$" & "];"
'Exécution de la requête
Rst.Open Requete, Cnn, 1, 3, 1
'La signification des 1
'Comme la bibliothèque n'est pas chargé, ont doit
'utiliser les références numériques des constantes textes
'Le premier 1 : CurseurType As CursorTypeEnum
'CurseurType= adOpenForwardOnly(0),adOpenStatic(3)
' adOpenKeyset(1),adOpenDynamic(2)
'Le deuxième 1 : ModeAccess As LockTypeEnum
'ModeAccess ­LockReadOnly(1),adLockPessimistic(2)
'adLockOptimistic(3),adLockBatchOptimistic(4)
'Le troisième 1 TypeCommand As CommandTypeEnum
'typecommand= adCmdText(1), adCmdFile(256)
'adCmdTable(2), adCmdTableDirec(512)
' adCmdUnknown(8), adCmdStoredProc(4)

'Si au moins un enregistrement
If Rst.EOF = False Then
'Va au dernier enregistrement du recordSet
Rst.movelast
'Comparaison entre les 2 valeurs
If Rst(0).Value <> Rg.Value Then
'Nombre de champ dans le recordset
X = Rst.Fields.Count - 1
With Rst
'Ajoute les données au recordset du classeur cible
.Addnew
'Pour chaque valeur de chaque champ
For a = 0 To X
Rst(a) = Rg.Offset(, a)
Next
'Mise à jour du recordset (enregistrement)
.Update
End With
Else
MsgBox "Aucune donnée ajoutée à la feuille " & Sh.Name & "."
End If
End If
'Fermeture du recordset
Rst.Close
Next
'Fermeture de la connection
Cnn.Close
'libération de l'espace mémoire occupé par ces objets.
Set Rst = Nothing: Set Cnn = Nothing
End Sub
'------------------------------------------------------------






MichD
---------------------------------------------------------------
"magic-dd" a écrit dans le message de groupe de discussion :
56325736-2056-423a-8d65-74ddbc161d46@googlegroups.com...

est ce beaucoup plus complexe à mettre en oeuvre en demandant de faire la
manip, avec seulement le classeur source ou cible ouvert?

Un dernier détail,

Les données que tu ajoutes dans chacune des colonnes
doivent être du même type que l'information déjà
contenue dans ces colonnes. (Comme dans Access)

MichD
---------------------------------------------------------------

Il serait sage de modifier la ligne de code suivante
If Rst.EOF = False Then

par celle-ci :

'Si au moins un enregistrement
If Rst.EOF = False And Rst.RecordCount >= 0 Then

IMPORTANT : Il est préférable d'avoir une ligne de données en dessous
de la ligne d'étiquette des feuilles du fichier de
destination.
Sinon, la procédure risque de confondre le type de
données
transféré et enregistrer les données au format texte.


Si tu utilises ce qui suit, la procédure prend quelques millisecondes de
plus
à s'exécuter, mais l'entretien de ton fichier risque d'être plus facile et
cette
approche est plus flexible, le cas échéant :

Quand tu ouvres le fichier de cette manière :
Set WkCible = GetObject(ThisWorkbook.Path & "Ado_Feuille_Destination.xlsm")

L'interface de la feuille de calcul est masquée et l'usager ne se rend pas
compte qu'un fichier s'ouvre...

'----------------------------------------------------
Sub test()
Dim WkSource As Workbook
Dim WkCible As Workbook
Dim Sh As Worksheet
Dim Nom As String, ValeurSource As Range
Dim ValeurCible As Range

Application.EnableEvents = False
Set WkSource = ThisWorkbook 'Où tu as copié la procédure
'En supposant que le classeur cible est source sont
'dans le même répertoire.
Set WkCible = GetObject(ThisWorkbook.Path & "Ado_Feuille_Destination.xlsm")

For Each Sh In WkSource.Worksheets
Nom = Sh.Name
Set ValeurSource = Sh.Range("A65536").End(xlUp)
With WkCible.Worksheets(Nom)
Set ValeurCible = .Range("A65536").End(xlUp)
If ValeurCible <> ValeurSource Then
ValeurSource.EntireRow.Copy ValeurCible.Offset(1)
Else
MsgBox "Pour la feuille source """ & Sh.Name & """ " & _
"il n'y a aucune ligne à copier."
End If
End With
Next
Workbooks(WkCible).Close True
Application.EnableEvents = False
End Sub
'----------------------------------------------------

MichD
---------------------------------------------------------------

--
Salutations
JJ


"MichD" <michdenis@hotmail.com> a écrit dans le message de news: k3cb11$tc0$1@speranza.aioe.org...

Il serait sage de modifier la ligne de code suivante
If Rst.EOF = False Then

par celle-ci :

'Si au moins un enregistrement
If Rst.EOF = False And Rst.RecordCount >= 0 Then

IMPORTANT : Il est préférable d'avoir une ligne de données en dessous
de la ligne d'étiquette des feuilles du fichier de destination.
Sinon, la procédure risque de confondre le type de données
transféré et enregistrer les données au format texte.


Si tu utilises ce qui suit, la procédure prend quelques millisecondes de plus
à s'exécuter, mais l'entretien de ton fichier risque d'être plus facile et cette
approche est plus flexible, le cas échéant :

Quand tu ouvres le fichier de cette manière :
Set WkCible = GetObject(ThisWorkbook.Path & "Ado_Feuille_Destination.xlsm")

L'interface de la feuille de calcul est masquée et l'usager ne se rend pas
compte qu'un fichier s'ouvre...

'----------------------------------------------------
Sub test()
Dim WkSource As Workbook
Dim WkCible As Workbook
Dim Sh As Worksheet
Dim Nom As String, ValeurSource As Range
Dim ValeurCible As Range

Application.EnableEvents = False
Set WkSource = ThisWorkbook 'Où tu as copié la procédure
'En supposant que le classeur cible est source sont
'dans le même répertoire.
Set WkCible = GetObject(ThisWorkbook.Path & "Ado_Feuille_Destination.xlsm")

For Each Sh In WkSource.Worksheets
Nom = Sh.Name
Set ValeurSource = Sh.Range("A65536").End(xlUp)
With WkCible.Worksheets(Nom)
Set ValeurCible = .Range("A65536").End(xlUp)
If ValeurCible <> ValeurSource Then
ValeurSource.EntireRow.Copy ValeurCible.Offset(1)
Else
MsgBox "Pour la feuille source """ & Sh.Name & """ " & _
"il n'y a aucune ligne à copier."
End If
End With
Next
Workbooks(WkCible).Close True
Application.EnableEvents = False
End Sub
'----------------------------------------------------

MichD
---------------------------------------------------------------