XL 2019 Vérifier si une ligne existe dans un autre fichier

A-F · 26 Janvier 2023

Bonjour tout le monde,
Est ce que qnn pourrait me dire comment je vérifier l'existence d'une ligne d'un fichier de départ dans un fichier de sortie?
je veut vérifier si mon code de fichier 1 existe dans fichier 2, et si oui copier un certaine colonne dans le fichier 2.

j'ai écrit ca, je n'ai pas d'erreur mais ca ne marche pas!

Code:

Sub Chek_EPCI()

Dim C As Range
    Dim nb As Integer, i As Long, j As Long, NextRow As Integer, nb_ligne_Oll As Long, nb_ligne_ECPI As Long
    Dim strAddress As String

Workbooks("OLL.xlsx").Activate
'FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
nb_ligne_Oll = WorksheetFunction.CountA(Range("A:A"))

Workbooks("EPCI.xlsx").Activate
nb_ligne_ECPI = WorksheetFunction.CountA(Range("A:A"))
                    i = 3
   
                For Each C In Workbooks("OLL.xlsx").Worksheets("EPCI").Range("C" & i & ":C" & nb_ligne_Oll) 'Le code dep
                    
                 
                    If C.Value = "85" Then ' si la valeure de cellule = 85
                         
                         For i = 3 To nb_ligne_Oll
                            For j = 2 To nb_ligne_ECPI
                                'If WorksheetFunction.Match(Workbooks("OLL.xlsx").Worksheets("EPCI").Cells("A" & i).Value, Workbooks("PPCI.xlsx").Worksheets("EPCI").Cells("A" & j).Value, 0) Then
                                    If Workbooks("OLL.xlsx").Worksheets("EPCI").Range("A" & i) = Workbooks("EPCI.xlsx").Worksheets("EPCI").Range("A" & j) Then
                                    
                                     Workbooks("OLL.xlsx").Worksheets("EPCI").Cells(i, 7) = Workbooks("EPCI.xlsx").Worksheets("EPCI").Cells(j, 5)
                                    Workbooks("OLL.xlsx").Worksheets("EPCI").Cells(i, 8) = Workbooks("EPCI.xlsx").Worksheets("EPCI").Cells(j, 6)
                                End If
                            Next
                             
                        Next
                End If
                        'End If
                        i = i + 1
                        
                Next
                
            
End Sub

Merci d'avance pour votre aide

Gégé-45550 · 26 Janvier 2023

Bonjour,
Dans le dossier OLL, insérer un module standard, y copier la macro ci-dessous puis affecter cette macro à un bouton sur la feuille EPCI dans le dossier OLL.
Ensuite, enregistrer le dossier OLL avec macro (.xlsm) et enfin lancer la macro avec le bouton.

VB:

Sub Copie()
Dim lstRowOLL%, lstrowEPCI%, i%, j%, k%, wbkOLL As Workbook, wbkEPCI As Workbook, shtOLL As Worksheet, shtEPCI As Worksheet
Set wbkOLL = Workbooks("OLL.xlsm")
Set wbkEPCI = Workbooks("EPCI.xlsx")
Set shtOLL = wbkOLL.Worksheets("EPCI")
Set shtEPCI = wbkEPCI.Worksheets("EPXCI")
k = 0
    lstRowOLL = shtOLL.Cells(Rows.Count, 1).End(xlUp).Row
    lstrowEPCI = shtEPCI.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 3 To lstRowOLL
        For j = 3 To lstrowEPCI
            If shtOLL.Range("A" & i) <> shtEPCI.Range("A" & j) Then 'vérifier si on doit tester une inégalité ou une égalité
                k = k + 1
                shtEPCI.Range("G" & (lstrowEPCI + k) & ":H" & (lstrowEPCI + k)) = shtOLL.Range("G" & i & ":H" & i) 'loyer2  => contrôler l'action de copier, je ne suis pas sûr d'avoir compris ou copier
            End If
        Next j
    Next i
Set wbkOLL = Nothing
Set wbkEPCI = Nothing
Set shtOLL = Nothing
Set shtEPCI = Nothing
End Sub

Attention, voir les 2 commentaires :
1. Je ne suis pas sûr de ce que l'on doit tester pour déclencher la copie, une inégalité (la donnée est absente dans EPCI.xlsx) ou une égalité (la donnée est présente dans EPCI.xlsx)
2. Je ne suis pas sûr de l'endroit ou copier le Range("G:H") dans EPCI
a vérifier et ajuster selon votre besoin.
Cordialement,

A-F · 26 Janvier 2023

Gégé-45550 à dit:
Bonjour,
Dans le dossier OLL, insérer un module standard, y copier la macro ci-dessous puis affecter cette macro à un bouton sur la feuille EPCI dans le dossier OLL.
Ensuite, enregistrer le dossier OLL avec macro (.xlsm) et enfin lancer la macro avec le bouton.

VB:

Sub Copie() Dim lstRowOLL%, lstrowEPCI%, i%, j%, k%, wbkOLL As Workbook, wbkEPCI As Workbook, shtOLL As Worksheet, shtEPCI As Worksheet Set wbkOLL = Workbooks("OLL.xlsm") Set wbkEPCI = Workbooks("EPCI.xlsx") Set shtOLL = wbkOLL.Worksheets("EPCI") Set shtEPCI = wbkEPCI.Worksheets("EPXCI") k = 0 lstRowOLL = shtOLL.Cells(Rows.Count, 1).End(xlUp).Row lstrowEPCI = shtEPCI.Cells(Rows.Count, 1).End(xlUp).Row For i = 3 To lstRowOLL For j = 3 To lstrowEPCI If shtOLL.Range("A" & i) <> shtEPCI.Range("A" & j) Then 'vérifier si on doit tester une inégalité ou une égalité k = k + 1 shtEPCI.Range("G" & (lstrowEPCI + k) & ":H" & (lstrowEPCI + k)) = shtOLL.Range("G" & i & ":H" & i) 'loyer2 => contrôler l'action de copier, je ne suis pas sûr d'avoir compris ou copier End If Next j Next i Set wbkOLL = Nothing Set wbkEPCI = Nothing Set shtOLL = Nothing Set shtEPCI = Nothing End Sub

Attention, voir les 2 commentaires :
1. Je ne suis pas sûr de ce que l'on doit tester pour déclencher la copie, une inégalité (la donnée est absente dans EPCI.xlsx) ou une égalité (la donnée est présente dans EPCI.xlsx)
2. Je ne suis pas sûr de l'endroit ou copier le Range("G:H") dans EPCI
a vérifier et ajuster selon votre besoin.
Cordialement,

Merci beaucoup,
je vais essayer d'adapter le code à ce que je veux. je vais sûrement revenir vers vous.

Pour déclencher la copie, j'utiliser un bouton sur un fichier externe ( mes codes je les écrit pas dans les classeurs OLL ou EPCI).

pour rependre à vos questions :
1) pour la premier colonne que je vais copier, je test une inégalité ( je copie dans un fichier vide que je demande de créer). Mais pour les colonnes d'après il y aura déjà le code EPCI pour tester l'égalité.

2) Je doit demander l'endroit où il faut copier la colonne.

Je viens de lancer le code mais il ne se passe rien. je n'ai pas d'erreur mais ca ne marche pas non plus.

job75 · 26 Janvier 2023

Bonjour,

Juste une remarque pour Gégé-45550, le code :

VB:

Set wbkOLL = Nothing
Set wbkEPCI = Nothing
Set shtOLL = Nothing
Set shtEPCI = Nothing

ne sert à rien puisque toutes les variables définies dans la macro sont réinitialisées à l'exécution du End Sub.

A+

Gégé-45550 · 26 Janvier 2023

job75 à dit:
Bonjour,

Juste une remarque pour Gégé-45550, le code :

VB:

Set wbkOLL = Nothing Set wbkEPCI = Nothing Set shtOLL = Nothing Set shtEPCI = Nothing

ne sert à rien puisque toutes les variables définies dans la macro sont réinitialisées à l'exécution du End Sub.

A+

Bien le bonjour job75 et merci pour l'info. Ah, cette vieille obsession à toujours vouloir vider la mémoire !!!

cathodique · 26 Janvier 2023

job75 à dit:
Bonjour,

Juste une remarque pour Gégé-45550, le code :

VB:

Set wbkOLL = Nothing Set wbkEPCI = Nothing Set shtOLL = Nothing Set shtEPCI = Nothing

ne sert à rien puisque toutes les variables définies dans la macro sont réinitialisées à l'exécution du End Sub.

A+

Bonjour @A-F , @Gégé-45550 , @job75,

@job75 : J'ai toujours cru que ça sert à libérer la mémoire utilisée.
Merci pour le partage.

Gégé-45550 · 26 Janvier 2023

Gégé-45550 à dit:
Bonjour,
Dans le dossier OLL, insérer un module standard, y copier la macro ci-dessous puis affecter cette macro à un bouton sur la feuille EPCI dans le dossier OLL.
Ensuite, enregistrer le dossier OLL avec macro (.xlsm) et enfin lancer la macro avec le bouton.

Bonsoir,
j'ai écrit ça cet après-midi un peu vite et sans tester.
À la relecture, il y a des corrections à faire, les voici :

VB:

Sub Copie()
Dim lstRowOLL%, lstrowEPCI%, i%, j%, k%, wbkOLL As Workbook, wbkEPCI As Workbook, shtOLL As Worksheet, shtEPCI As Worksheet, OK As Boolean, Chemin$
Dim NomWbk As String
Dim NomSht As String
Dim Wbk As Workbook
Dim Ouvert As Boolean
Ouvert = False
For Each Wbk In Excel.Application.Workbooks
    With Wbk
        If .Name = "EPCI.xlsx" Then     'Si EPCI.xlsx est ouvert ...
            Ouvert = True
            Exit For
        End If
    End With
Next Wbk
Chemin = ActiveWorkbook.Path & "\"
NomWbk = Chemin & "EPCI.xlsx"
If Ouvert = False Then
    Set wbkEPCI = Workbooks.Open(NomWbk)
Else
    SetAttr NomWbk, vbNormal 'propriété lecture-écriture
    Set wbkEPCI = Workbooks("EPCI.xlsx")
End If
Set wbkOLL = Workbooks("OLL.xlsm")
Set shtOLL = wbkOLL.Worksheets("EPCI")
Set shtEPCI = wbkEPCI.Worksheets("EPCI")
OK = True
k = 0
    lstRowOLL = shtOLL.Cells(Rows.Count, 1).End(xlUp).Row
    lstrowEPCI = shtEPCI.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 3 To lstRowOLL
        For j = 3 To lstrowEPCI
            If shtOLL.Range("A" & i) = shtEPCI.Range("A" & j) Then
                Exit For
            Else
                OK = False
                Exit For
            End If
        Next j
        If OK = False Then
            k = k + 1
            shtEPCI.Range("G" & (lstrowEPCI + k) & ":H" & (lstrowEPCI + k)).Value = shtOLL.Range("G" & i & ":H" & i).Value 'loyer2
            OK = True
        End If
    Next i
    If Not Ouvert Then wbkEPCI.Close savechanges:=True
End Sub

et toujours vérifier quelles données doivent être copiées et où.
Cordialement,

A-F · 27 Janvier 2023

Gégé-45550 à dit:

Bonsoir,
j'ai écrit ça cet après-midi un peu vite et sans tester.
À la relecture, il y a des corrections à faire, les voici :

VB:

Sub Copie()
Dim lstRowOLL%, lstrowEPCI%, i%, j%, k%, wbkOLL As Workbook, wbkEPCI As Workbook, shtOLL As Worksheet, shtEPCI As Worksheet, OK As Boolean, Chemin$
Dim NomWbk As String
Dim NomSht As String
Dim Wbk As Workbook
Dim Ouvert As Boolean
Ouvert = False
For Each Wbk In Excel.Application.Workbooks
    With Wbk
        If .Name = "EPCI.xlsx" Then     'Si EPCI.xlsx est ouvert ...
            Ouvert = True
            Exit For
        End If
    End With
Next Wbk
Chemin = ActiveWorkbook.Path & "\"
NomWbk = Chemin & "EPCI.xlsx"
If Ouvert = False Then
    Set wbkEPCI = Workbooks.Open(NomWbk)
Else
    SetAttr NomWbk, vbNormal 'propriété lecture-écriture
    Set wbkEPCI = Workbooks("EPCI.xlsx")
End If
Set wbkOLL = Workbooks("OLL.xlsm")
Set shtOLL = wbkOLL.Worksheets("EPCI")
Set shtEPCI = wbkEPCI.Worksheets("EPCI")
OK = True
k = 0
    lstRowOLL = shtOLL.Cells(Rows.Count, 1).End(xlUp).Row
    lstrowEPCI = shtEPCI.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 3 To lstRowOLL
        For j = 3 To lstrowEPCI
            If shtOLL.Range("A" & i) = shtEPCI.Range("A" & j) Then
                Exit For
            Else
                OK = False
                Exit For
            End If
        Next j
        If OK = False Then
            k = k + 1
            shtEPCI.Range("G" & (lstrowEPCI + k) & ":H" & (lstrowEPCI + k)).Value = shtOLL.Range("G" & i & ":H" & i).Value 'loyer2
            OK = True
        End If
    Next i
    If Not Ouvert Then wbkEPCI.Close savechanges:=True
End Sub

et toujours vérifier quelles données doivent être copiées et où.
Cordialement,

Bonjour et merci beaucoup,
J'ai réussi à faire ce que je voulais faire mais ton code est beaucoup plus optimiser que le mien. Je vais m'en servir pour améliorer mon code.

Effectuez une recherche sur Excel Downloads...

XL 2019 Vérifier si une ligne existe dans un autre fichier

A-F

XLDnaute Nouveau

Pièces jointes

Gégé-45550

XLDnaute Accro

A-F

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Gégé-45550

XLDnaute Accro

cathodique

XLDnaute Barbatruc

Gégé-45550

XLDnaute Accro

A-F

XLDnaute Nouveau

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums