Consolidation NDF en bouclant sur tous les onglets

[GADENSEB]

Bonjour le Forum
Je reprend l'excellent code dudumomo

http://www.excel-downloads.com/forum/234894-macro-consolidation-de-plusieurs-fichiers-en-une-seule-table-2.html#post1503910


Je gére des notes de frais de 12 salariés que je dois regrouper pour faire ensuite des analyses sur les dépenses.

Toutes les NDF sont construite de la mm méniére :
- 1 Onglet par mois (JANVIER à DECEMBRE)
- Les données sont dans les cellules A11 : J28
- Le titre des données en ligne 10 --> A10:J10

Du coup avec le code suivant que j'ai un peu modifié déjà, j'ai qq soucis,

Dans un premier temps :
- La récupération des données (sur l'onglet JANVIER) ne se fait pas correctement
Je m'explique :
Suivant la procédure je devrais récuperer les données des plages A11:J28

Cependant les données récupérée sont de A1:J28 !!!!

De ce que je comprends, le soucis viens de la ligne :

xdlgnsource = wbksource.Sheets("JANVIER").Range("A28").End(xlUp).Row: xnblgnsource = xdlgnsource - 2

Que faut-il modifier ?

Option Explicit
Dim wbk As Workbook, wbksource As Workbook, Fichierexistant As Range, Plagederecherche As Range
Dim Chemin As String, Nomfichier As String, Fichiersource As String, NomOnglet As String, xsrefn, xsdate
Dim xdlgn As Long, xdlgnsource As Long, xnblgnsource As Long, i As Long, j As Long, xlgn As Integer, xcol As Integer

Private Sub CommandButton1_Click()
  ' Lancer la consolidation
  ' Tous les fichiers doivent se trouver dans le même répertoire - extension xlsm -
  ' ainsi que le fichier RECAPITULATIF.xlsm
    Application.ScreenUpdating = False
    
  'Efface les données
    Range("a5:L5000").Select
    Selection.Value = ""
    

    Application.DisplayAlerts = False
    Chemin = ThisWorkbook.Path & "\"
    Set wbk = ActiveWorkbook
    Set Plagederecherche = wbk.Sheets(1).Columns(1)
    Nomfichier = Dir(Chemin & "\NDF*.xlsm")
  
    Do While Nomfichier <> ""
        ' Méthode Find
        Set Fichierexistant = Plagederecherche.Cells.Find(What:=Nomfichier, LookAt:=xlWhole)
        If Fichierexistant Is Nothing Then
            Set wbksource = Nothing
            Fichiersource = Chemin & Nomfichier
            Set wbksource = Workbooks.Open(Filename:=Fichiersource)
             xdlgnsource = wbksource.Sheets("JANVIER").Range("A28").End(xlUp).Row: xnblgnsource = xdlgnsource - 2
     '      NomOnglet = Workbooks.Sheets(1).Name
            
             ' Copie les données dans le fichier RECAPITULATIF
            
            With wbk.Sheets(1)
             
               xdlgn = .Range("A" & Rows.Count).End(xlUp).Row + 1
                xlgn = 5: xcol = 1: j = xdlgn
                    For i = xdlgn To xdlgn + xnblgnsource
                            wbk.Sheets(1).Cells(j, 1) = Nomfichier
                            wbk.Sheets(1).Cells(j, 2) = NomOnglet
                            wbk.Sheets(1).Cells(j, 3).Value = wbksource.Sheets("JANVIER").Cells(xlgn, 1).Value
                            wbk.Sheets(1).Cells(j, 4).Value = wbksource.Sheets("JANVIER").Cells(xlgn, 2).Value
                            wbk.Sheets(1).Cells(j, 5).Value = wbksource.Sheets("JANVIER").Cells(xlgn, 3).Value
                            wbk.Sheets(1).Cells(j, 6).Value = wbksource.Sheets("JANVIER").Cells(xlgn, 4).Value
                            wbk.Sheets(1).Cells(j, 7).Value = wbksource.Sheets("JANVIER").Cells(xlgn, 5).Value
                            wbk.Sheets(1).Cells(j, 8).Value = wbksource.Sheets("JANVIER").Cells(xlgn, 6).Value
                            wbk.Sheets(1).Cells(j, 9).Value = wbksource.Sheets("JANVIER").Cells(xlgn, 7).Value
                            wbk.Sheets(1).Cells(j, 10).Value = wbksource.Sheets("JANVIER").Cells(xlgn, 8).Value
                            wbk.Sheets(1).Cells(j, 11).Value = wbksource.Sheets("JANVIER").Cells(xlgn, 9).Value
                            wbk.Sheets(1).Cells(j, 12).Value = wbksource.Sheets("JANVIER").Cells(xlgn, 10).Value
                            j = j + 1
                        xlgn = xlgn + 1
                   Next i
            End With
            wbksource.Close
        End If
        Nomfichier = Dir
    Loop
    Set wbk = Nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Traitement terminé."
End Sub

QQn aurais une idée?


Bonne journée
Seb

 

[GADENSEB]

Re : Consolidation NDF en bouclant sur tous les onglets

Un petit Up !

 

[Paf]

Re : Consolidation NDF en bouclant sur tous les onglets

Bonjour

Supprimé, mauvaise réponse.