Tansfert de donnees entre classeurs
Le
magic-dd
bonsoir
je possede 2 classeurs, le cible et la source
mon classeur cible comporte le meme nombre d'onglets avec le meme nom de fe=
uille que le classeur source.
le but recherché est de mettre à jour ma cible en fonction de ma source=
.
vous me direz qu'avec un copier coller cà serait simple or je ne veux cop=
ier que ma dernière ligne de ma source vers ma cible ( sur le meme onglet=
) seulement si la date de ma source est differente de ma cible.
exemple
classeur cible
donnees jusqu'en ligne 25
en A25 j'ai la date Aout 2012
sur mon source j'ai des donnees jusqu'en ligne 211
en A 212 j'ai la date Sept 2012
Dans ce cas, il va copier la ligne 212 et va la coller valeur en A26 de ma =
cible
si dans le cas ou les dates etaient identiques alors petit message genre "a=
ucune donnees à inserer"
j'espere avoir été assez explicite
merci par avance
je possede 2 classeurs, le cible et la source
mon classeur cible comporte le meme nombre d'onglets avec le meme nom de fe=
uille que le classeur source.
le but recherché est de mettre à jour ma cible en fonction de ma source=
.
vous me direz qu'avec un copier coller cà serait simple or je ne veux cop=
ier que ma dernière ligne de ma source vers ma cible ( sur le meme onglet=
) seulement si la date de ma source est differente de ma cible.
exemple
classeur cible
donnees jusqu'en ligne 25
en A25 j'ai la date Aout 2012
sur mon source j'ai des donnees jusqu'en ligne 211
en A 212 j'ai la date Sept 2012
Dans ce cas, il va copier la ligne 212 et va la coller valeur en A26 de ma =
cible
si dans le cas ou les dates etaient identiques alors petit message genre "a=
ucune donnees à inserer"
j'espere avoir été assez explicite
merci par avance
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
---------------------------------------------------------------
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
des feuilles était le même...
Bonne supposition c'est exactement ca
seulement je crois que les 2 classeurs doivent etre ouverts
Effectivement, c'est l'approche la plus simple!
MichD
---------------------------------------------------------------
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 :
est ce beaucoup plus complexe à mettre en oeuvre en demandant de faire la
manip, avec seulement le classeur source ou cible ouvert?
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
---------------------------------------------------------------
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"