Transfert des donnees à partir d'un Userform
Résolu
r4944
Messages postés
136
Statut
Membre
-
r4944 Messages postés 136 Statut Membre -
r4944 Messages postés 136 Statut Membre -
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:
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
1 réponse
-
Bonjour,
Selection du fichier:
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 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
