1 2 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 54 55 56 57 58 59 60 61 62 63 64 65 66 67
| Sub import_RH()
Dim fichierAOuvrir As Workbook
Dim index As Integer 'index de la liste des fichiers
Dim ListesDesFichiersAOuvrir As Variant
Dim sFiltre As String, bMultiSelect As Boolean
Dim k, fichierBDD As String
' recupere le nom de la bdd
fichierBDD = ActiveWorkbook.Name
sFiltre = "Fichiers XYZ (.xls)(.xlsm), *.xls*"
ListesDesFichiersAOuvrir = Selectionner_Fichiers("Sélectionner les fichiers à compiler")
If IsArray(ListesDesFichiersAOuvrir) Then
For index = 1 To UBound(ListesDesFichiersAOuvrir)
'On ouvre le fihier
Set fichierAOuvrir = Workbooks.Open(ListesDesFichiersAOuvrir(index))
'récupère les données identités dans recensement
Dim i As Integer, n As Range
Windows(fichierAOuvrir.Name).Activate
Sheets("1.Identité").Select
Range("A50").Value = Range("B4:e4").Value
Range("B50").Value = Range("b3:e3").Value
Range("c50").Value = Range("g3:j3").Value
Range("a50:c50").Select
Selection.Copy
'Positionnement dans la bdd
Workbooks(fichierBDD).Activate
Sheets("Recensement_MAJ").Select
Set n = Worksheets("Recensement_MAJ").Range("A4")
'i = CStr(n)
Range("A" & i + 4).Select
'Range("a4").Select
'Collage des données
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'--------------------------Fermer---------
Windows(fichierAOuvrir.Name).Activate
ActiveWorkbook.Close False
Next index
Else
MsgBox "Annuler"
End If
End Sub
Function Selectionner_Fichiers(sTitre As String) As Variant
Dim sFiltre As String, bMultiSelect As Boolean
sFiltre = "Fichiers XYZ (.xls)(.xlsm), *.xls*"
bMultiSelect = True 'Permet de choisir plusieurs fichiers à la fois
Selectionner_Fichiers = Application.GetOpenFilename(Filefilter:=sFiltre, Title:=sTitre, MultiSelect:=bMultiSelect)
End Function |
Partager