mon classeur cible comporte le meme nombre d'onglets avec le meme nom de fe=
uille que le classeur source.
le but recherch=E9 est de mettre =E0 jour ma cible en fonction de ma source=
.
vous me direz qu'avec un copier coller c=E0 serait simple or je ne veux cop=
ier que ma derni=E8re ligne de ma source vers ma cible ( sur le meme onglet=
) seulement si la date de ma source est differente de ma cible.
exemple=20
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 =E0 inserer"
'------------------------------------------ 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 '------------------------------------------
'------------------------------------------
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
'------------------------------------------
'------------------------------------------ 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 '------------------------------------------
est ce beaucoup plus complexe à mettre en oeuvre en demandant de faire la manip, avec seulement le classeur source ou cible ouvert?
MichD
| 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 :
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?
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?
MichD
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)
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 '----------------------------------------------------
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
'----------------------------------------------------
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" a écrit dans le message de news: k3cb11$tc0$
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" <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" a écrit dans le message de news: k3cb11$tc0$
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 '----------------------------------------------------