Discussion :

[GADENSEB]

Bonjour le Forum
Je reprend l'excellent code dudumomo?

(je tente le coup sur ce forum, voir si qqn à des idées ;-))


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 :
Code :
xdlgnsource = wbksource.Sheets("JANVIER").Range("A28").End(xlUp).Row: xnblgnsource = xdlgnsource - 2

Que faut-il modifier ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
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?

[goldstar]

Bonjour,

Je vous propose le code suivant.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
68
 
 
Dim w As Integer, ligneDebutSource As Integer, ligneFinSource As Integer, ligneDebCible As Integer, nbligneSource As Integer
Dim laFeuilleSource As String
Dim feuille_cible As Worksheet, feuille_source As Worksheet
 
' 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").ClearContents
    '''''''Selection.Value = ""
 
    Application.DisplayAlerts = False
    Chemin = ThisWorkbook.Path & "\"
 
    Set wbk = ActiveWorkbook
    Set feuille_cible = wbk.Worksheets("RESULT NEEDED")
 
    Set Plagederecherche = wbk.Sheets(1).Columns(1)
    Nomfichier = Dir(Chemin & "\NDF*.xlsm")
 
    Do While Nomfichier <> "" 'Parcours des fichiers du repertoire courant
        ' 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)
 
            For w = 1 To wbksource.Worksheets.Count 'parcours de tous les onglets du fichier source
                laFeuilleSource = wbksource.Sheets(w).Name
                Set feuille_source = wbksource.Worksheets(laFeuilleSource)
 
                'Ligne de début de la feuille source
                If feuille_source.Range("A1") <> "" Then
                    ligneDebutSource = 2
                Else
                    ligneDebutSource = feuille_source.Range("A1").End(xlDown).Row + 1
                End If
 
                'Ligne de fin de la feuille source
                ligneFinSource = feuille_source.Range("A65535").End(xlUp).Row
 
                nbligneSource = ligneFinSource - ligneDebutSource
 
                ligneDebCible = feuille_cible.Range("a" & Rows.Count).End(xlUp).Row + 1
 
                feuille_cible.Range(feuille_cible.Cells(ligneDebCible, 1), feuille_cible.Cells(ligneDebCible + nbligneSource, 1)).Value = Fichiersource
                feuille_cible.Range(feuille_cible.Cells(ligneDebCible, 2), feuille_cible.Cells(ligneDebCible + nbligneSource, 2)).Value = laFeuilleSource
                feuille_cible.Range(feuille_cible.Cells(ligneDebCible, 3), feuille_cible.Cells(ligneDebCible + nbligneSource, 12)).Value = feuille_source.Range(feuille_source.Cells(ligneDebutSource, 1), feuille_source.Cells(ligneFinSource, 10)).Value
 
                Set feuille_source = Nothing
 
            Next w
 
            'Fermeture du fichier source
            wbksource.Close
 
        End If
        Nomfichier = Dir
    Loop
    Set wbk = Nothing
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Traitement terminé."

Cordialement,

[GADENSEB]

Hello merci du code
mais cela ne fonctionne pas, j'ai un



sur la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

feuille_cible.Range(feuille_cible.Cells(ligneDebCible, 1), feuille_cible.Cells(ligneDebCible + nbligneSource, 1)).Value = Fichiersource

Par contre, chose que je ne comprends pas :

Pourquoi partir de

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

 ligneDebutSource = feuille_source.Range("A1").End(xlDown).Row + 1

alors que les tableaux commencent en A10 (ligne du titre ?)

[GADENSEB]

Petit complement d'information que je viens de penser.
Tous les fichiers ont ces onglets :
JANVIER
FEVRIER
MARS
AVRIL
MAI
JUIN
JUILLET
AOUT
SEPTEMBRE
OCTOBRE
NOVEMBRE
DECEMBRE
SYNTHESE
LISTES

La consolisdation doit se faire sur les onglets JANVIER à DECEMBRE
avec des données en A11:J28 et des titres de colonnes en ligne A10:J10
Les 2 autres onglets ne sont pas paramétrés comme les autres et ne sont pas à tenir en compte !!

désolé de l'oubli

Hello !!

Un petit Up pour savoir si qqn aurait une idée ?

Hello Le forum
Je ne trouve pas la solution....snifff
qqn aurait une idée ?