| 12
 3
 4
 5
 6
 7
 8
 9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 
 | Option Explicit
Option Compare Text
 
Sub ExtractionCotisation()
    '
    'Les tableaux de chaque classeur sont supposés commencer dans la cellule A1
    '
    Dim W1 As Worksheet, W2 As Worksheet, W3 As Worksheet, W4 As Worksheet
    Dim Ce1 As Range, Ce3 As Range
    Dim Plage2 As Range, Plage3 As Range, Plage4 As Range
    Dim x As Integer, y As Integer, z As Integer
 
    Set W1 = Workbooks("Fichier1.xls").Sheets("Feuil1")
    Set W2 = Workbooks("Fichier2.xls").Sheets("Feuil1")
    Set W3 = Workbooks("Fichier3.xls").Sheets("Feuil1")
    Set W4 = Workbooks("Fichier4.xls").Sheets("Feuil1")
 
    'Boucle sur les noms dans le Fichier1
    For Each Ce1 In W1.Range("A2:A" & W1.Range("A2").End(xlDown).Row)
 
        'Définit la Plage de recherche de noms dans le Fichier2
        Set Plage2 = W2.Range("A1:A" & W2.Range("A1").End(xlDown).Row)
 
        On Error Resume Next
        'Vérifie si le nom existe dans le Fichier2
        x = Application.WorksheetFunction.Match(Ce1, Plage2, 0)
            'Si oui
            If x > 0 Then
 
                'Récupère la plage des années de cotisation pour le nom spécifié
                Set Plage3 = W2.Range(W2.Cells(x, 2), _
                            W2.Cells(x, W2.Cells(x, 2).End(xlToRight).Column))
 
                'Boucle sur les années de cotisation
                For Each Ce3 In Plage3
 
                    'Définit la Plage des montants de cotisation
                    Set Plage4 = W3.Range("A1:A" & W3.Range("A2").End(xlDown).Row)
                    'Récupère le numéro de ligne de cotisation spécifié
                    y = Application.WorksheetFunction.Match(Ce3, Plage4, 0)
 
                    If y > 0 Then
                        z = W4.Range("A65536").End(xlUp).Row + 1
 
                        W4.Cells(z, 1) = Ce1
                        W4.Cells(z, 2) = Ce3
                        W4.Cells(z, 3) = W3.Cells(y, 2)
                    End If
                Next Ce3
            End If
    Next Ce1
 
End Sub | 
Partager