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

A-F

XLDnaute Nouveau
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
 

Pièces jointes

  • OLL.xlsx
    10.2 KB · Affichages: 5
  • EPCI.xlsx
    16.5 KB · Affichages: 4
Dernière édition:

Gégé-45550

XLDnaute Accro
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

XLDnaute Nouveau
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.
 
Dernière édition:

job75

XLDnaute Barbatruc
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

XLDnaute Accro
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

XLDnaute Barbatruc
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

XLDnaute Accro
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,
 
Dernière édition:

A-F

XLDnaute Nouveau
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.
 

Statistiques des forums

Discussions
311 711
Messages
2 081 786
Membres
101 817
dernier inscrit
carvajal