XL 2016 Incrémentation de valeur avec VBA

Bonsoir à Tous!

J'ai vraiment besoin d'aide.

J'ai un code VBA qui me permet d'ouvrir plusieurs classeurs, de copier certaines valeurs que je dois normalement coller dans un autre classeur.

Le probleme c'est qu'il n'incrimente pas les valeurs copier. Elles restent toujours à la meme cellule.

Au fait je recois des rapports journaliers que je dois compiler et analyser.

Je vous met le code :


Sub data_base()


Dim wbRecap As Workbook

Dim wsRecap As Worksheet

Dim wbSource As Workbook

Dim wsSource As Worksheet

Dim derlign As Integer

Dim vfichier As Variant

Dim i As Integer, k As Integer

Dim rgrecap As Range


Set wbRecap = ThisWorkbook

Set wsRecap = wbRecap.Sheets(2)


vFichiers = Selectionner_Fichiers(" ")


If Not IsArray(vFichiers) Then

Debug.Print "Aucun fichier sélectionné."

MsgBox "erreur! Aucun/Mauvais fichier sélectionné."

Exit Sub

End If

On Error Resume Next



Application.ScreenUpdating = False


For k = 1 To UBound(vFichiers)


Application.StatusBar = ">> Lecture du fichier #" & k & "/" & UBound(vFichers)




Set wbSource = Workbooks.Open(vFichiers(k))

Set wsSource = wbSource.Sheets(1)


DernLign = wsRecap.Range("A65000").End(xlUp).Offset(1, 0)



wsRecap.Range("C3").Offset(1, 0).Value = wsSource.Range("G18").Value




wbSource.Close

Set wbSource = Nothing

Next k



Application.ScreenUpdating = True
Application.StatusBar = False


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

Selectionner_Fichiers = Application.GetOpenFilename(Filefilter:=sFiltre, Title:=sTitre, MultiSelect:=bMultiSelect)


End Function