Transfert des donnees à partir d'un Userform

Bonjour,

j'ai crée un userform avec un bouton parourir , j'aime bien savoir comment faire ou quelle methode dois-je utiliser pour selectionner un ou plusieurs fichiers excel et transférer leurs donnees avec une condition notons que c'est la meme condition qui doit s'appliquer à chaque fois (la condition : transferer seulement les lignes qui ont XX dans la colonne AP ) le transfert se fait vers la feuille ouverte (qui contienne le userform)

pour le moment je fais ca a travers un boutton mais je dois toujours changer le chemin du fichier.

Voici le code que J'utilise:

Option Explicit
Option Base 1
'--------
Sub Importdata23()
Dim Source As Workbook, Dercol As Integer
Dim Nbre As Integer, Tablo, Cptr As Integer, Lig As Integer, Col As Integer

    Application.ScreenUpdating = False

    Set Source = Application.Workbooks.Open("C:\Users\xx@yy\Desktop\Updatev3.xlsm", , True)
    With Sheets("Workload - Charge de travail")
        Dercol = .Rows(2).Find(what:="*", searchdirection:=xlPrevious).Column
        Nbre = Application.CountIf(.Columns("AP"), "XX")
        ReDim Tablo(Nbre, Dercol)
        Lig = 1
        For Cptr = 1 To Nbre
            Lig = .Columns("AP").Find("XX", .Cells(Lig, "AP"), xlValues).Row
            For Col = 1 To Dercol
                Tablo(Cptr, Col) = .Cells(Lig, Col)
            Next Col
        Next Cptr
    End With
    Source.Close False

    With ThisWorkbook.Sheets("Sheet1")
        .Range("A2").Resize(Cptr, Dercol) = Tablo
        .Activate
    End With

End Sub

Bonjour

Une piste [a=https://support.microsoft.com/fr-fr/kb/465507][/a]

Option Explicit
Option Base 1
'--------
Sub Importdata23()
Dim Source As Workbook, Dercol As Integer
Dim Nbre As Integer, Tablo, Cptr As Integer, Lig As Integer, Col As Integer
Dim FichiersAOuvrir, I As Integer

  Application.ScreenUpdating = False

  FichiersAOuvrir = Application.GetOpenFilename(, , , , True)
  If IsArray(FichiersAOuvrir) Then
    For I = LBound(FichiersAOuvrir, 1) To UBound(FichiersAOuvrir, 1)
      Set Source = Application.Workbooks.Open(FichiersAOuvrir(I), , True)
      With Sheets("Workload - Charge de travail")
        Dercol = .Rows(2).Find(what:="*", searchdirection:=xlPrevious).Column
        Nbre = Application.CountIf(.Columns("AP"), "XX")
        ReDim Tablo(Nbre, Dercol)
        Lig = 1
        For Cptr = 1 To Nbre
          Lig = .Columns("AP").Find("XX", .Cells(Lig, "AP"), xlValues).Row
          For Col = 1 To Dercol
            Tablo(Cptr, Col) = .Cells(Lig, Col)
          Next Col
        Next Cptr
      End With
      Source.Close False

      With ThisWorkbook.Sheets("Sheet1")
        .Range("A2").Resize(Cptr, Dercol) = Tablo
        '.Activate
      End With
    Next I
  Else
    MsgBox "Aucun choix"
  End If
End Sub

Merci pour votre réponse

j'ai travaillé avec ce code ci dessous ca m'aide bien mais seulement avec un seul fichier , le probleme c'est que je dois faire un saut de ligne pour qu'il ne commence pas toujours avec la Range A2

Option Explicit
Option Base 1
'--------
Sub Importdata2345()
Dim Source As Workbook, Dercol As Integer
Dim Nbre As Integer, Tablo, Cptr As Integer, Lig As Integer, Col As Integer
Dim CheminFichier

    Application.ScreenUpdating = False
    'selection fichier source
    CheminFichier = Application.GetOpenFilename("Classeur Excel (*.xls*), *.xls*")
    If CheminFichier = False Then   'pas de fichier
        Exit Sub
    Else
       Set Source = Workbooks.Open(Filename:=CheminFichier)
        With Sheets("Workload - Charge de travail")
            Dercol = .Rows(2).Find(what:="*", searchdirection:=xlPrevious).Column
            Nbre = Application.CountIf(.Columns("AP"), "XX")
            ReDim Tablo(Nbre, Dercol)
            Lig = 1
            For Cptr = 1 To Nbre
                Lig = .Columns("AP").Find("XX", .Cells(Lig, "AP"), xlValues).Row
                For Col = 1 To Dercol
                    Tablo(Cptr, Col) = .Cells(Lig, Col)
                Next Col
            Next Cptr
        End With
        Source.Close False
        Set Source = Nothing
    End If
    With ThisWorkbook.Sheets("Sheet1")
        .Range("A2").Resize(Cptr, Dercol) = Tablo
        .Activate
    End With
End Sub

Bonsoir

Il y a une question ou c'est seulement une information que tu veux transmettre ?

Amicalement

je voulais savoir comment copier a partir de la premiére rangee vide

merci

Bonsoir

Sans fichier pour tester

Modifies la macro

Option Explicit
Option Base 1
'--------
Sub Importdata23()
Dim Source As Workbook, Dercol As Integer
Dim Nbre As Integer, Tablo, Cptr As Integer, Lig As Integer, Col As Integer
Dim FichiersAOuvrir, I As Integer

  Application.ScreenUpdating = False

  FichiersAOuvrir = Application.GetOpenFilename(, , , , True)
  If IsArray(FichiersAOuvrir) Then
    For I = LBound(FichiersAOuvrir, 1) To UBound(FichiersAOuvrir, 1)
      Set Source = Application.Workbooks.Open(FichiersAOuvrir(I), , True)
      With Sheets("Workload - Charge de travail")
        Dercol = .Rows(2).Find(what:="*", searchdirection:=xlPrevious).Column
        Nbre = Application.CountIf(.Columns("AP"), "XX")
        ReDim Tablo(Nbre, Dercol)
        Lig = 1
        For Cptr = 1 To Nbre
          Lig = .Columns("AP").Find("XX", .Cells(Lig, "AP"), xlValues).Row
          For Col = 1 To Dercol
            Tablo(Cptr, Col) = .Cells(Lig, Col)
          Next Col
        Next Cptr
      End With
      Source.Close False

      With ThisWorkbook.Sheets("Sheet1")
        .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Resize(Cptr, Dercol) = Tablo
        '.Range("A2").Resize(Cptr, Dercol) = Tablo
        '.Activate
      End With
    Next I
  Else
    MsgBox "Aucun choix"
  End If
End Sub

Merci pour tout ca marche parfaitement

Bonne journee