Macro: étendre une recherche sur un repertoire

Workbooks.OpenText Filename:="D:\Users\ysebbarh.EMEA\Desktop\test_macro\RAF1.txt"

Set wb_RAF1 = ActiveWorkbook

Set ws_RAF1 = wb_RAF1.Worksheets(1)

Set cel_trouvee = ws_RAF1.Columns(1).Find(cel_cherchee.Value)

Dim FSO As New FileSystemObject

Dim fldr_RAF As Folder

Dim file_RAF As File

 
Set fldr_RAF = FSO.GetFolder("D:\Users\woow\Desktop\RAF")

 
MsgBox "Bonjour, je suis le répertoire " & fldr_RAF.Name

 
For Each file_RAF In fldr_RAF.Files

    If UCase(file_RAF.Name) Like "RAF*.XLS" Then

        MsgBox "J'ai trouvé le fichier " & file_RAF.Name & ". Il faudrait le traiter. " & vbCrLf & _

               "Son nom complet est : " & vbCrLf & _

               file_RAF.Path

    Else

        MsgBox "J'ai trouvé le fichier " & file_RAF.Name & ". Mais il ne nous intéresse pas."

    End If

Next

Option Expplicit

Sub TraiterFichierRAF(ByRef nomfic_NIR As String, ByRef nomfic_RAF As String)

    Dim wb_RAF       As Workbook

    Dim wb_NIR       As Workbook

    Dim sb_RAF       As Worksheet

    Dim sb_NIR       As Worksheet

    Dim ws_resultat  As Worksheet

    Dim cel_cherchee As Range

    Dim cel_trouvee  As Range

    Dim cel_resultat As Range

 
    Workbooks.OpenText Filename:=nomfic_NIR

    Set wb_NIR = ActiveWorkbook

    Set ws_NIR = wb_NIR.Worksheets(1)

    ws_NIR.Columns(1).NumberFormat = "0"

 
    Workbooks.OpenText Filename:=nomfic_RAF

    Set wb_RAF = ActiveWorkbook

    Set ws_RAF = wb_RAF.Worksheets(1)

 
    Set ws_resultat = wb_NIR.Worksheets.Add

    ws_resultat.Name = "Resultat"

    Set cel_resultat = ws_resultat.Range("A1" )

 
    For Each cel_cherchee In ws_NIR.Range("A2:A16" )

        Set cel_trouvee = ws_RAF.Columns(1).Find(cel_cherchee.Value)

        Do

            cel_resultat.Value = cel_trouvee.Value

            Set cel_resultat = cel_resultat.Offset(1)

            Set cel_trouvee = cel_trouvee.Offset(1)

        Loop Until (Left(cel_trouvee.Text, 14)) = "S30.G01.00.001"

    Next

End Sub

Sub TraiterRepertoire(ByRef nomfic_NIR As String, ByRef repertoire_RAF As String)

    Dim FSO As New FileSystemObject

    Dim fldr_RAF As Folder

    Dim file_RAF As File

 
    Set fldr_RAF = FSO.GetFolder(repertoire_RAF)

 
    For Each file_RAF In fldr_RAF.Files

        If UCase(file_RAF.Name) Like "RAF*.XLS" Then TraiterFichierRAF nomfic_NIR, file_RAF.Path

    Next

End Sub

cel_resultat.Value = cel_trouvee.Value

Option Explicit

 
Sub TraiterRepertoire(ByRef nomfic_NIR2 As String, ByRef repertoire_RAF As String)

    Dim FSO As New FileSystemObject

    Dim fldr_RAF As Folder

    Dim file_RAF As File

 
 
    Set fldr_RAF = FSO.GetFolder("C:\Projet\RAF")

 
    For Each file_RAF In fldr_RAF.Files

        If UCase(file_RAF.Name) Like "RAF*" Then TraiterFichierRAF nomfic_NIR2, file_RAF.Path

    Next

End Sub

 
Sub TraiterFichierRAF(ByRef nomfic_NIR2 As String, ByRef nomfic_RAF3 As String)

    Dim wb_RAF3      As Workbook

    Dim wb_NIR2      As Workbook

    Dim ws_RAF3      As Worksheet

    Dim ws_NIR2      As Worksheet

    Dim ws_resultat  As Worksheet

    Dim cel_cherchee As Range

    Dim cel_trouvee  As Range

    Dim cel_resultat As Range

 
    Workbooks.OpenText Filename:="d:\Users\woow\Desktop\NIR2.txt"

    Set wb_NIR2 = ActiveWorkbook

    Set ws_NIR2 = wb_NIR2.Worksheets(1)

    ws_NIR2.Columns(1).NumberFormat = "0"

 
    Workbooks.OpenText Filename:="C:\Projet\RAF\RAF3.txt"

    Set wb_RAF3 = ActiveWorkbook

    Set ws_RAF3 = wb_RAF3.Worksheets(1)

 
    Set ws_resultat = wb_NIR2.Worksheets.Add

    ws_resultat.Name = "Resultat"

    Set cel_resultat = ws_resultat.Range("A1")

 
    For Each cel_cherchee In ws_NIR2.Range("A2:A7")

        Set cel_trouvee = ws_RAF3.Columns(1).Find(cel_cherchee.Value)

        Do

             cel_resultat.Value = cel_trouvee.Value

            Set cel_resultat = cel_resultat.Offset(1)

            Set cel_trouvee = cel_trouvee.Offset(1)

        Loop Until (Left(cel_trouvee.Text, 14)) = "S30.G01.00.001"

    Next

End Sub

 
 
Sub start()

Dim nomfic_NIR2 As String

Dim nomfic_RAF3 As String

Dim repertoire_RAF As String

Call TraiterRepertoire(nomfic_NIR2, repertoire_RAF)

 
Call TraiterFichierRAF(nomfic_NIR2, nomfic_RAF3)

End Sub

Dim trouve As Range

 
Set trouve = Worksheets(1).Cells.Find("introuvable")

Stop

Set cel_trouvee = ws_RAF.Columns(1).Find(cel_cherchee.Value)

    If Not cel_trouvee Is Nothing Then

       Do

          cel_resultat.Value = cel_trouvee.Value

            Set cel_resultat = cel_resultat.Offset(1)

            Set cel_trouvee = cel_trouvee.Offset(1)

            ligne = ligne + 1

        Loop Until (Left(cel_trouvee.Text, 14)) = "S30.G01.00.001"

   End If

Workbooks.OpenText Filename:="d:\Users\woow\Desktop\NIR2.txt"

Option Explicit

 
Sub TraiterRepertoire(ByRef nomfic_NIR2 As String, ByRef repertoire_RAF As String)

    Dim FSO As New FileSystemObject

    Dim fldr_RAF As Folder

    Dim file_RAF As File

 
 
    Set fldr_RAF = FSO.GetFolder("C:\Projet\RAF")

 
    For Each file_RAF In fldr_RAF.Files

        If UCase(file_RAF.Name) Like "RAF*" Then TraiterFichierRAF nomfic_NIR2, file_RAF.Path

    Next

End Sub

 
Sub TraiterFichierRAF(ByRef nomfic_NIR2 As String, ByRef nomfic_RAF As String)

    Dim wb_RAF      As Workbook

    Dim wb_NIR2      As Workbook

    Dim ws_RAF      As Worksheet

    Dim ws_NIR2      As Worksheet

    Dim ws_resultat  As Worksheet

    Dim cel_cherchee As Range

    Dim cel_trouvee  As Range

    Dim cel_resultat As Range

    Static v_open As Boolean '-------------------Nouveau

    Dim ligne As Single

    If Not v_open Then  '-------------------Nouveau

      Workbooks.OpenText Filename:="d:\Users\ys.EMEA\Desktop\NIR2.txt"

      v_open = True '-------------------Nouveau

    End If '-------------------Nouveau

    Set wb_NIR2 = ActiveWorkbook

    Set ws_NIR2 = wb_NIR2.Worksheets(1)

    ws_NIR2.Columns(1).NumberFormat = "0"

 
    Workbooks.OpenText Filename:=nomfic_RAF  '-------------------Nouveau

    Set wb_RAF = ActiveWorkbook

    Set ws_RAF = wb_RAF.Worksheets(1)

 
    Set ws_resultat = wb_RAF.Worksheets.Add

    ws_resultat.Name = "Resultat"

    Set cel_resultat = ws_resultat.Range("A1")

 
    For Each cel_cherchee In ws_NIR2.Range("A1:A5")

        Set cel_trouvee = ws_RAF.Columns(1).Find(cel_cherchee.Value)

    If Not cel_trouvee Is Nothing Then

       Do

          cel_resultat.Value = cel_trouvee.Value

            Set cel_resultat = cel_resultat.Offset(1)

            Set cel_trouvee = cel_trouvee.Offset(1)

           ligne = ligne + 1

        Loop Until (Left(cel_trouvee.Text, 14)) = "S30.G01.00.001"

   End If

 
   Next

 
End Sub

 
 
Sub start()

Dim nomfic_NIR2 As String

Dim nomfic_RAF As String

Call TraiterRepertoire("d:\Users\ys.EMEA\Desktop\NIR2.txt", "C:\Projet\RAF")

End Sub

For Each cel_NIS_cherchee In ws_NIR2.Range("A1:A5")

        Set cel_RAF_trouvee = ws_RAF.Columns(1).Find(cel_NIS_cherchee.Value)

        If Not cel_RAF_trouvee Is Nothing Then

            Do

               cel_REF_resultat.Value = cel_RAF_trouvee.Value

              Set cel_REF_resultat = cel_REF_resultat.Offset(1)

                Set cel_RAF_trouvee = cel_RAF_trouvee.Offset(1)

           Loop Until cel_RAF_trouvee.Text Like "S30.G01.00.001*"

        End If

   Next

   End Sub

sub Synthese ()

dim ws as worksheet 

dim L as integer , C as integer

dim Lcible as integer

dim plage as range

dim synthese as worksheet

fo each ws in worksheets

Lcible = worksheets(synthese").Range("A65536").End(xLUp).Row+1

if ws.name = "resultat" then

with ws

L=.Range("A65536").End(xLUp).Row

C=.Range("A1").End(xLToRight).Column

set Plage=.Range(Cells(1,1).Adress,Cells(L,C).Adress)

Plage.copy Destination:=Worksheets("synthese".Range("A"&Lcible)

End with

End If

Next ws

End sub

Sub synthese(ws_synthese As Worksheet)

    Dim source   As Range

    Dim cible    As Range

    Dim ws       As Worksheet

 
    cible = ws_synthese.Range("A65536").End(xlUp).Offset(1)

    For Each wb In Workbooks

        For Each ws In wb.Worksheets

            If ws.Name = "resultat" Then

                Set source = ws.Range("A1").CurrentRegion

                source.Copy Destination:=cible

                Set cible = cible.Offset(source.Rows.Count)            

            End If

        End If

    Next

End Sub