VBA, problème dans ma fonction IF
Résolu
gathou13
Messages postés
13
Statut
Membre
-
gathou13 Messages postés 13 Statut Membre -
gathou13 Messages postés 13 Statut Membre -
Bonjour,
Je travaille sur un projet, je dois transférer des données entre 2 fichiers excel. Ce sont des listes de matériels identifiés par un numéro d'agence.
Je dois comparer chaque numéro, et les gérer selon les cas suivants :
Si on retrouve le même numéro je recopie les caractéristiques associées sinon je créé une nouvelle ligne avec toutes les données associées.
Je ne comprends pas pourquoi ma condition du IF n'est jamais vrai alors que j'ai fait le test avec deux fichiers comportant des n° d'agence identique.
Pourriez-vous m'expliquer et me donner une solution à mon erreur ?
De plus, je n'arrive pas à trouver une solution pour mon deuxième problème. J'aimerais que si le matériel existe déjà il ne créé pas de ligne supplémentaire.
Merci d'avance de votre aide
Voici mon code..
Sub CopierDonnees()
Dim Entree As Workbook, Sortie As Workbook
Nomfichierentree = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")
' On verifie que l'on a selectionné un nom de classeur
If Nomfichierentree <> False Then
' On ouvre le classeur
Set Veritas = Workbooks.Open(Nomfichierentree)
NomFichierSortie = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")
If NomFichierSortie <> False Then
Set Sioux = Workbooks.Open(NomFichierSortie)
Dim i As Integer, j As Integer, k As Integer, lg As Integer, lg2 As Integer
i = 4 'numéro de la première cellule à comparer du fichier SIOUX
j = 2 'numéro de la première cellule à comparer du fichier Veritas
k = Cells(Rows.Count, 2).End(xlUp).row + 1 'numéro de la dernière cellule non vide du fichier SIOUX
lg = Cells(Rows.Count, 2).End(xlUp).row
lg2 = Veritas.Worksheets(1).Range("C65536").End(xlUp).row
'Copier/coller des données
While (j < lg2 And k < 65536)
For i = 4 To lg
' si le num d'agence est identique alors je modifie les données
If (Veritas.Worksheets(1).Range("U" & j).Value = Sioux.Worksheets(1).Range("B" & i).Value) Then
'la date du dernier contrôle du fichier SIOUX doit être égale à celle de Veritas
Sioux.Worksheets(1).Range("B" & i).Value = Veritas.Worksheets(1).Range("U" & j).Value
'la conclusion du dernier contrôle du fichier SIOUX doit être la même à celle de Veritas
Sioux.Worksheets(1).Range("B" & i).Value = Veritas.Worksheets(1).Range("U" & j).Value
'sinon créer une nouvelle ligne pour le nouveau matériel
Else
Sioux.Worksheets(1).Range("B" & k).Value = Veritas.Worksheets(1).Range("U" & j).Value
'mettre toutes les caractéristiques importantes du nouvel matériel dans SIOUX
Sioux.Worksheets(1).Range("E" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("P" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("G" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("Q" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("R" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("R" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("AA" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("W" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("L" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("I" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("K" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("K" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("J" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("V" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("Q" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("F" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("V" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("S" & j).Offset(lig).Value
End If
Next
k = k + 1
j = j + 1
Wend
' On ferme le classeur
Sioux.Close
End If
' On ferme le second
Veritas.Close
End If
End Sub
Je travaille sur un projet, je dois transférer des données entre 2 fichiers excel. Ce sont des listes de matériels identifiés par un numéro d'agence.
Je dois comparer chaque numéro, et les gérer selon les cas suivants :
Si on retrouve le même numéro je recopie les caractéristiques associées sinon je créé une nouvelle ligne avec toutes les données associées.
Je ne comprends pas pourquoi ma condition du IF n'est jamais vrai alors que j'ai fait le test avec deux fichiers comportant des n° d'agence identique.
Pourriez-vous m'expliquer et me donner une solution à mon erreur ?
De plus, je n'arrive pas à trouver une solution pour mon deuxième problème. J'aimerais que si le matériel existe déjà il ne créé pas de ligne supplémentaire.
Merci d'avance de votre aide
Voici mon code..
Sub CopierDonnees()
Dim Entree As Workbook, Sortie As Workbook
Nomfichierentree = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")
' On verifie que l'on a selectionné un nom de classeur
If Nomfichierentree <> False Then
' On ouvre le classeur
Set Veritas = Workbooks.Open(Nomfichierentree)
NomFichierSortie = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")
If NomFichierSortie <> False Then
Set Sioux = Workbooks.Open(NomFichierSortie)
Dim i As Integer, j As Integer, k As Integer, lg As Integer, lg2 As Integer
i = 4 'numéro de la première cellule à comparer du fichier SIOUX
j = 2 'numéro de la première cellule à comparer du fichier Veritas
k = Cells(Rows.Count, 2).End(xlUp).row + 1 'numéro de la dernière cellule non vide du fichier SIOUX
lg = Cells(Rows.Count, 2).End(xlUp).row
lg2 = Veritas.Worksheets(1).Range("C65536").End(xlUp).row
'Copier/coller des données
While (j < lg2 And k < 65536)
For i = 4 To lg
' si le num d'agence est identique alors je modifie les données
If (Veritas.Worksheets(1).Range("U" & j).Value = Sioux.Worksheets(1).Range("B" & i).Value) Then
'la date du dernier contrôle du fichier SIOUX doit être égale à celle de Veritas
Sioux.Worksheets(1).Range("B" & i).Value = Veritas.Worksheets(1).Range("U" & j).Value
'la conclusion du dernier contrôle du fichier SIOUX doit être la même à celle de Veritas
Sioux.Worksheets(1).Range("B" & i).Value = Veritas.Worksheets(1).Range("U" & j).Value
'sinon créer une nouvelle ligne pour le nouveau matériel
Else
Sioux.Worksheets(1).Range("B" & k).Value = Veritas.Worksheets(1).Range("U" & j).Value
'mettre toutes les caractéristiques importantes du nouvel matériel dans SIOUX
Sioux.Worksheets(1).Range("E" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("P" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("G" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("Q" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("R" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("R" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("AA" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("W" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("L" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("I" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("K" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("K" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("J" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("V" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("Q" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("F" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("V" & k).Offset(lig).Value = Veritas.Worksheets(1).Range("S" & j).Offset(lig).Value
End If
Next
k = k + 1
j = j + 1
Wend
' On ferme le classeur
Sioux.Close
End If
' On ferme le second
Veritas.Close
End If
End Sub
A voir également:
- VBA, problème dans ma fonction IF
- Fonction si et - Guide
- Fonction miroir - Guide
- Fonction moyenne excel - Guide
- Fonction remplacer dans word - Guide
- Excel compter cellule couleur sans vba - Guide
3 réponses
Bonjour,
Pour t'aider, dans le visual Basic Editor affiche la fenêtre "Données Local" (dans ma version anglaise c'est "Local Windows"). Dans cet écran s'affichera toutes tes variables avec le contenu de chacune.
Exécute ta macro pas à pas avec la touche F8 et compare le contenu des variable que tu met en confrontation.
Le problème peux venir du format des cellule comparé. Une cellule au format texte apparaitra entre Guillemet alors qu'une donnée numérique apparaitra en brute.
Pour ton 2eme problèmes Si tu pouvais fournir 2 fichiers en exemple (via le site cijoint.com) avec juste 3 ligne de contenu, ça serait surper.
Pour t'aider, dans le visual Basic Editor affiche la fenêtre "Données Local" (dans ma version anglaise c'est "Local Windows"). Dans cet écran s'affichera toutes tes variables avec le contenu de chacune.
Exécute ta macro pas à pas avec la touche F8 et compare le contenu des variable que tu met en confrontation.
Le problème peux venir du format des cellule comparé. Une cellule au format texte apparaitra entre Guillemet alors qu'une donnée numérique apparaitra en brute.
Pour ton 2eme problèmes Si tu pouvais fournir 2 fichiers en exemple (via le site cijoint.com) avec juste 3 ligne de contenu, ça serait surper.
Rebonjour,
J'ai réécrit une partie du code que voici :
Je te laisse compléter le code aux endroits où c'est mentionné "mettre les instructions".
Si tu as des questions n'hésites pas.
Sub CopierDonnees()
Dim Entree As Workbook, Sortie As Workbook
Dim i As Integer, u As Integer, j As Integer, k As Integer, Nb_Ligne_E As Integer, Nb_Ligne_S As Integer
Dim NomFichierEntree As Variant, NomFichierSortie As Variant
CheminFichierEntree = Application.GetOpenFilename("*,*")
' On verifie que l'on a selectionné un nom de classeur
If CheminFichierEntree <> False Then
' On ouvre le classeur
Workbooks.Open (CheminFichierEntree)
NomFichierEntree = ActiveWorkbook.Name
CheminFichierSortie = Application.GetOpenFilename("*,*")
If CheminFichierSortie <> False Then
Workbooks.Open (CheminFichierSortie)
NomFichierSortie = ActiveWorkbook.Name
k = Cells(Rows.Count, 2).End(xlUp).Row + 1 'numéro de la dernière cellule non vide du fichier SIOUX
Application.ScreenUpdating = False
Workbooks(NomFichierEntree).Activate
Nb_Ligne_E = Sheets(1).Cells(Rows.Count, 3).End(xlUp).Row
Workbooks(NomFichierSortie).Activate
Nb_Ligne_S = Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row
Application.ScreenUpdating = True
'Copier/coller des données
' Trouve = 0
While k < Rows.Count
For i = 2 To Nb_Ligne_E
RefENTREE = Workbooks(NomFichierEntree).Sheets(1).Cells(i, 3).Text
For u = 4 To Nb_Ligne_S
RefSORTIE = Workbooks(NomFichierSortie).Sheets(1).Cells(u, 2).Text
If RefENTREE = RefSORTIE Then
'Mettre les instructions sur la ligne u du Fichier Sortie
' Trouve = 1
GoTo Suite
End If
Next u
'Mettre les instruction sur la ligne k du fichier Sortie
Suite:
Next i
k = k + 1
Wend
' On ferme le classeur
Workbooks(NomFichierSortie).Close
End If
' On ferme le second
Workbooks(NomFichierEntree).Close
End If
J'ai réécrit une partie du code que voici :
Je te laisse compléter le code aux endroits où c'est mentionné "mettre les instructions".
Si tu as des questions n'hésites pas.
Sub CopierDonnees()
Dim Entree As Workbook, Sortie As Workbook
Dim i As Integer, u As Integer, j As Integer, k As Integer, Nb_Ligne_E As Integer, Nb_Ligne_S As Integer
Dim NomFichierEntree As Variant, NomFichierSortie As Variant
CheminFichierEntree = Application.GetOpenFilename("*,*")
' On verifie que l'on a selectionné un nom de classeur
If CheminFichierEntree <> False Then
' On ouvre le classeur
Workbooks.Open (CheminFichierEntree)
NomFichierEntree = ActiveWorkbook.Name
CheminFichierSortie = Application.GetOpenFilename("*,*")
If CheminFichierSortie <> False Then
Workbooks.Open (CheminFichierSortie)
NomFichierSortie = ActiveWorkbook.Name
k = Cells(Rows.Count, 2).End(xlUp).Row + 1 'numéro de la dernière cellule non vide du fichier SIOUX
Application.ScreenUpdating = False
Workbooks(NomFichierEntree).Activate
Nb_Ligne_E = Sheets(1).Cells(Rows.Count, 3).End(xlUp).Row
Workbooks(NomFichierSortie).Activate
Nb_Ligne_S = Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row
Application.ScreenUpdating = True
'Copier/coller des données
' Trouve = 0
While k < Rows.Count
For i = 2 To Nb_Ligne_E
RefENTREE = Workbooks(NomFichierEntree).Sheets(1).Cells(i, 3).Text
For u = 4 To Nb_Ligne_S
RefSORTIE = Workbooks(NomFichierSortie).Sheets(1).Cells(u, 2).Text
If RefENTREE = RefSORTIE Then
'Mettre les instructions sur la ligne u du Fichier Sortie
' Trouve = 1
GoTo Suite
End If
Next u
'Mettre les instruction sur la ligne k du fichier Sortie
Suite:
Next i
k = k + 1
Wend
' On ferme le classeur
Workbooks(NomFichierSortie).Close
End If
' On ferme le second
Workbooks(NomFichierEntree).Close
End If
en faisant pas à pas il va créer et inscrire indéfiniment la dernière ligne du fichier d'entrée dans celui de sortie
c'est peut être que j'ai mal compris ce qu'il fallait incorporer dans les 'mettre les instructions'
j'ai mis
'Mettre les instructions sur la ligne u du Fichier Sortie
'la date du dernier contrôle du fichier SIOUX doit être égale à celle de Dekra
Workbooks(NomFichierSortie).Worksheets(1).Range("J" & u).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("F" & i).Value
'la conclusion du dernier contrôle du fichier SIOUX doit être la même à celle de Dekra
Workbooks(NomFichierSortie).Worksheets(1).Range("AA" & u).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("E" & i).Value
'Mettre les instruction sur la ligne k du fichier Sortie
Workbooks(NomFichierSortie).Worksheets(1).Range("B" & k).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("C" & i).Value
Workbooks(NomFichierSortie).Worksheets(1).Range("E" & k).Offset(lig).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("A" & i).Offset(lig).Value
Workbooks(NomFichierSortie).Worksheets(1).Range("G" & k).Offset(lig).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("B" & i).Offset(lig).Value
Workbooks(NomFichierSortie).Worksheets(1).Range("R" & k).Offset(lig).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("D" & i).Offset(lig).Value
Workbooks(NomFichierSortie).Worksheets(1).Range("AA" & k).Offset(lig).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("E" & i).Offset(lig).Value
Workbooks(NomFichierSortie).Worksheets(1).Range("L" & k).Offset(lig).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("K" & i).Offset(lig).Value
Workbooks(NomFichierSortie).Worksheets(1).Range("K" & k).Offset(lig).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("L" & i).Offset(lig).Value
c'est peut être que j'ai mal compris ce qu'il fallait incorporer dans les 'mettre les instructions'
j'ai mis
'Mettre les instructions sur la ligne u du Fichier Sortie
'la date du dernier contrôle du fichier SIOUX doit être égale à celle de Dekra
Workbooks(NomFichierSortie).Worksheets(1).Range("J" & u).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("F" & i).Value
'la conclusion du dernier contrôle du fichier SIOUX doit être la même à celle de Dekra
Workbooks(NomFichierSortie).Worksheets(1).Range("AA" & u).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("E" & i).Value
'Mettre les instruction sur la ligne k du fichier Sortie
Workbooks(NomFichierSortie).Worksheets(1).Range("B" & k).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("C" & i).Value
Workbooks(NomFichierSortie).Worksheets(1).Range("E" & k).Offset(lig).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("A" & i).Offset(lig).Value
Workbooks(NomFichierSortie).Worksheets(1).Range("G" & k).Offset(lig).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("B" & i).Offset(lig).Value
Workbooks(NomFichierSortie).Worksheets(1).Range("R" & k).Offset(lig).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("D" & i).Offset(lig).Value
Workbooks(NomFichierSortie).Worksheets(1).Range("AA" & k).Offset(lig).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("E" & i).Offset(lig).Value
Workbooks(NomFichierSortie).Worksheets(1).Range("L" & k).Offset(lig).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("K" & i).Offset(lig).Value
Workbooks(NomFichierSortie).Worksheets(1).Range("K" & k).Offset(lig).Value = Workbooks(NomFichierEntree).Worksheets(1).Range("L" & i).Offset(lig).Value
Ah non ça vient de mon code :
Voici la verion modifiée :
Sub CopierDonnees()
Dim Entree As Workbook, Sortie As Workbook
Dim i As Integer, u As Integer, j As Integer, k As Integer, Nb_Ligne_E As Integer, Nb_Ligne_S As Integer
Dim NomFichierEntree As Variant, NomFichierSortie As Variant
CheminFichierEntree = Application.GetOpenFilename("*,*")
' On verifie que l'on a selectionné un nom de classeur
If CheminFichierEntree <> False Then
' On ouvre le classeur
Workbooks.Open (CheminFichierEntree)
NomFichierEntree = ActiveWorkbook.Name
CheminFichierSortie = Application.GetOpenFilename("*,*")
If CheminFichierSortie <> False Then
Workbooks.Open (CheminFichierSortie)
NomFichierSortie = ActiveWorkbook.Name
k = Cells(Rows.Count, 2).End(xlUp).Row + 1 'numéro de la dernière cellule non vide du fichier SIOUX
Application.ScreenUpdating = False
Workbooks(NomFichierEntree).Activate
Nb_Ligne_E = Sheets(1).Cells(Rows.Count, 3).End(xlUp).Row
Workbooks(NomFichierSortie).Activate
Nb_Ligne_S = Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row
Application.ScreenUpdating = True
'Copier/coller des données
For i = 2 To Nb_Ligne_E
RefENTREE = Workbooks(NomFichierEntree).Sheets(1).Cells(i, 3).Text
For u = 4 To Nb_Ligne_S
RefSORTIE = Workbooks(NomFichierSortie).Sheets(1).Cells(u, 2).Text
If RefENTREE = RefSORTIE Then
'Mettre les instructions sur la ligne u du Fichier Sortie
u = 0
GoTo Suite
End If
Next u
'Mettre les instruction sur la ligne k du fichier Sortie
Suite:
k = k + 1
If k > Rows.Count Then
MsgBox ("La limite de la feuille est atteinte")
Exit For
End If
Next i
' On ferme le classeur
Workbooks(NomFichierSortie).Close
End If
' On ferme le second
Workbooks(NomFichierEntree).Close
End If
Voici la verion modifiée :
Sub CopierDonnees()
Dim Entree As Workbook, Sortie As Workbook
Dim i As Integer, u As Integer, j As Integer, k As Integer, Nb_Ligne_E As Integer, Nb_Ligne_S As Integer
Dim NomFichierEntree As Variant, NomFichierSortie As Variant
CheminFichierEntree = Application.GetOpenFilename("*,*")
' On verifie que l'on a selectionné un nom de classeur
If CheminFichierEntree <> False Then
' On ouvre le classeur
Workbooks.Open (CheminFichierEntree)
NomFichierEntree = ActiveWorkbook.Name
CheminFichierSortie = Application.GetOpenFilename("*,*")
If CheminFichierSortie <> False Then
Workbooks.Open (CheminFichierSortie)
NomFichierSortie = ActiveWorkbook.Name
k = Cells(Rows.Count, 2).End(xlUp).Row + 1 'numéro de la dernière cellule non vide du fichier SIOUX
Application.ScreenUpdating = False
Workbooks(NomFichierEntree).Activate
Nb_Ligne_E = Sheets(1).Cells(Rows.Count, 3).End(xlUp).Row
Workbooks(NomFichierSortie).Activate
Nb_Ligne_S = Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row
Application.ScreenUpdating = True
'Copier/coller des données
For i = 2 To Nb_Ligne_E
RefENTREE = Workbooks(NomFichierEntree).Sheets(1).Cells(i, 3).Text
For u = 4 To Nb_Ligne_S
RefSORTIE = Workbooks(NomFichierSortie).Sheets(1).Cells(u, 2).Text
If RefENTREE = RefSORTIE Then
'Mettre les instructions sur la ligne u du Fichier Sortie
u = 0
GoTo Suite
End If
Next u
'Mettre les instruction sur la ligne k du fichier Sortie
Suite:
k = k + 1
If k > Rows.Count Then
MsgBox ("La limite de la feuille est atteinte")
Exit For
End If
Next i
' On ferme le classeur
Workbooks(NomFichierSortie).Close
End If
' On ferme le second
Workbooks(NomFichierEntree).Close
End If
Merci pour la rapidité de ta réponse =)
J'avais du m'emmêler comme j'ai créé un prog pratiquement identique puisqu'il fallait que je gère un fichier du même type mais avec des données organisées différemment et celui là marchait; J'ai copié et collé ce prog en modifiant qq lignes et ca a marché!
Pour mon deuxième problème, j'ai joint mes deux fichiers.
j'ai mis en rouge sur mon fichier de sortie les données qui étaient présente avant l'application de mon prog. On s'aperçoit qu'il a donc créé une ligne même si l'article existait, j'aimerais qu'il n y est plus de duplication (ligne 7 et 5)
Merci pour l'aide!
https://www.cjoint.com/?3GwmmnnFzfw
https://www.cjoint.com/?3GwmnNAMmYx
J'avais du m'emmêler comme j'ai créé un prog pratiquement identique puisqu'il fallait que je gère un fichier du même type mais avec des données organisées différemment et celui là marchait; J'ai copié et collé ce prog en modifiant qq lignes et ca a marché!
Pour mon deuxième problème, j'ai joint mes deux fichiers.
j'ai mis en rouge sur mon fichier de sortie les données qui étaient présente avant l'application de mon prog. On s'aperçoit qu'il a donc créé une ligne même si l'article existait, j'aimerais qu'il n y est plus de duplication (ligne 7 et 5)
Merci pour l'aide!
https://www.cjoint.com/?3GwmmnnFzfw
https://www.cjoint.com/?3GwmnNAMmYx
le voici, mais le tien marche très bien
Sub CopierDonnees()
Dim Dekra As Workbook, Sioux As Workbook
NomFichierEntree = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")
' On verifie que l'on a selectionné un nom de classeur
If NomFichierEntree <> False Then
' On ouvre le classeur
Set Dekra = Workbooks.Open(NomFichierEntree)
NomFichierSortie = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")
If NomFichierSortie <> False Then
Set Sioux = Workbooks.Open(NomFichierSortie)
Dim i As Integer, j As Integer, k As Integer, lg As Integer, lg2 As Integer
i = 4 'numéro de la première cellule à comparer du fichier SIOUX
j = 2 'numéro de la première cellule à comparer du fichier DEKRA
k = Cells(Rows.Count, 2).End(xlUp).row + 1 'numéro de la dernière cellule non vide du fichier SIOUX
lg = Cells(Rows.Count, 2).End(xlUp).row
lg2 = Dekra.Worksheets(1).Range("C65536").End(xlUp).row
'Copier/coller des données
While (j < lg2 And k < 65536)
For i = 4 To lg
' si le num d'agence est identique alors je modifie les données
If (Dekra.Worksheets(1).Range("C" & j).Value = Sioux.Worksheets(1).Range("B" & i).Value) Then
'la date du dernier contrôle du fichier SIOUX doit être égale à celle de Dekra
Sioux.Worksheets(1).Range("J" & i).Value = Dekra.Worksheets(1).Range("F" & j).Value
'la conclusion du dernier contrôle du fichier SIOUX doit être la même à celle de Dekra
Sioux.Worksheets(1).Range("AA" & i).Value = Dekra.Worksheets(1).Range("E" & j).Value
'sinon créer une nouvelle ligne pour le nouveau matériel
Else
Sioux.Worksheets(1).Range("B" & k).Value = Dekra.Worksheets(1).Range("C" & j).Value
'mettre toutes les caractéristiques importantes du nouvel matériel dans SIOUX
Sioux.Worksheets(1).Range("E" & k).Offset(lig).Value = Dekra.Worksheets(1).Range("A" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("G" & k).Offset(lig).Value = Dekra.Worksheets(1).Range("B" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("R" & k).Offset(lig).Value = Dekra.Worksheets(1).Range("D" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("AA" & k).Offset(lig).Value = Dekra.Worksheets(1).Range("E" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("L" & k).Offset(lig).Value = Dekra.Worksheets(1).Range("K" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("K" & k).Offset(lig).Value = Dekra.Worksheets(1).Range("L" & j).Offset(lig).Value
End If
Next
k = k + 1
j = j + 1
Wend
' On ferme le classeur
Sioux.Close
End If
' On ferme le second
Dekra.Close
End If
End Sub
Sub CopierDonnees()
Dim Dekra As Workbook, Sioux As Workbook
NomFichierEntree = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")
' On verifie que l'on a selectionné un nom de classeur
If NomFichierEntree <> False Then
' On ouvre le classeur
Set Dekra = Workbooks.Open(NomFichierEntree)
NomFichierSortie = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")
If NomFichierSortie <> False Then
Set Sioux = Workbooks.Open(NomFichierSortie)
Dim i As Integer, j As Integer, k As Integer, lg As Integer, lg2 As Integer
i = 4 'numéro de la première cellule à comparer du fichier SIOUX
j = 2 'numéro de la première cellule à comparer du fichier DEKRA
k = Cells(Rows.Count, 2).End(xlUp).row + 1 'numéro de la dernière cellule non vide du fichier SIOUX
lg = Cells(Rows.Count, 2).End(xlUp).row
lg2 = Dekra.Worksheets(1).Range("C65536").End(xlUp).row
'Copier/coller des données
While (j < lg2 And k < 65536)
For i = 4 To lg
' si le num d'agence est identique alors je modifie les données
If (Dekra.Worksheets(1).Range("C" & j).Value = Sioux.Worksheets(1).Range("B" & i).Value) Then
'la date du dernier contrôle du fichier SIOUX doit être égale à celle de Dekra
Sioux.Worksheets(1).Range("J" & i).Value = Dekra.Worksheets(1).Range("F" & j).Value
'la conclusion du dernier contrôle du fichier SIOUX doit être la même à celle de Dekra
Sioux.Worksheets(1).Range("AA" & i).Value = Dekra.Worksheets(1).Range("E" & j).Value
'sinon créer une nouvelle ligne pour le nouveau matériel
Else
Sioux.Worksheets(1).Range("B" & k).Value = Dekra.Worksheets(1).Range("C" & j).Value
'mettre toutes les caractéristiques importantes du nouvel matériel dans SIOUX
Sioux.Worksheets(1).Range("E" & k).Offset(lig).Value = Dekra.Worksheets(1).Range("A" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("G" & k).Offset(lig).Value = Dekra.Worksheets(1).Range("B" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("R" & k).Offset(lig).Value = Dekra.Worksheets(1).Range("D" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("AA" & k).Offset(lig).Value = Dekra.Worksheets(1).Range("E" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("L" & k).Offset(lig).Value = Dekra.Worksheets(1).Range("K" & j).Offset(lig).Value
Sioux.Worksheets(1).Range("K" & k).Offset(lig).Value = Dekra.Worksheets(1).Range("L" & j).Offset(lig).Value
End If
Next
k = k + 1
j = j + 1
Wend
' On ferme le classeur
Sioux.Close
End If
' On ferme le second
Dekra.Close
End If
End Sub