Discussion :

[GekkoWallst]

Bonjour à toutes et à tous,

je fais appel à votre génie pour m'aider à comprendre ce qui ne va pas dans mon code vba qui a pour objectif d'ouvrir tous les classeurs d'un dossier (dossier 2018) et de parcourir toutes les feuilles de la numéro 4 à la 15. Pour chacune des feuilles je lui demande de copier un tableau en commençant en ligne 3 jusqu'à la dernière ligne, puis de coller les sélections les unes en dessous des autres dans un autre classeur "conso fichier"...

l’exécution de cette ne se déroulement pas correctement, elle bloque à "for j..."

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
Sub ouvertureclasseur()
 
    Dim Chemin As String, Fichier As String
 
    'Définit le répertoire contenant les fichiers
    Chemin = "U:\2018\"
 
    'Boucle sur tous les fichiers xls du répertoire.
 
    Fichier = Dir(Chemin & "*.xls")
 
    Do While Len(Fichier) > 0
        'écrit le résultat dans la fenêtre d'exécution (Ctrl+G).
        Debug.Print Chemin & Fichier
        Fichier = Dir()
 
        'pour lire toutes les feuilles à consolider
 
     For j = 4 To 15
 
     Sheets(j).Select
     derniereligne = Range("a1000000").End(xlUp).Row
 
        For i = 3 To derniereligne
 
     Sheets(j).Select
     Rows(i).Select
     Selection.Copy
        Workbooks("conso fichier").Activate
 
     Sheets("feuil1").Select
     lastrowfeuil1 = Range("a1000000").End(xlUp).Row + 1
     Cells(lastrowfeuil1, 1).Select
     ActiveSheet.Paste
     Application.CutCopyMode = False
 
        Next i
 
     Next j
 
 
    Loop
 
 
End Sub

Je vous remercie par avance pour le temps et l'attention que vous porterez à ma demande,

Merci pour vos retours !

[halaster08]

Bonjour,

Je ne vois dans ton code aucune instruction d'ouverture (ni de fermeture d'ailleurs) de fichier

Par pitié, vire moi tout ses select inutiles

Code :

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

1
2
3
4
5
6
7
8
9
     Sheets(j).Select
     Rows(i).Select
     Selection.Copy
        Workbooks("conso fichier").Activate
 
     Sheets("feuil1").Select
     lastrowfeuil1 = Range("a1000000").End(xlUp).Row + 1
     Cells(lastrowfeuil1, 1).Select
     ActiveSheet.Paste

s'écrit:

Code :

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

1
2
    lastrowfeuil1 = Workbooks("conso fichier").Sheets("feuil1").Range("a1000000").End(xlUp).Row + 1
     Sheets(j).Rows(i).Copy Workbooks("conso fichier").Sheets("feuil1").Cells(lastrowfeuil1, 1)

[GekkoWallst]

merci pour cette correction halaster08,

[Igloobel]

Bonjour à tous,

Pour compléter ce qu'à dit halaster08 Moi pour l'ouverture de tes fichiers j'utiliserai les "File dialogs"

L'avantage c'est que c'est facile à comprendre (plein de code dans l'aide en ligne : F1),
tu peux utiliser le Multiselect (donc sélectionner tous les fichiers que tu veux traiter)
et c'est propre et facile à maintenir (utilisation des boites de dialogues VBA (Word Excel, Access, Power point, ...))

Concernant ta boucle sur les feuilles

Je te conseille d'utiliser le For Each
et d'utiliser CodeName de la feuille

[GekkoWallst]

Bonjour à tous,

Igloobel, merci pour ta réponse, j'ai essayé avec le code suivant mais ça plante mon fichier excel, aucune réponse.. peut-être trop long

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
Sub Consolidation()
 
Dim Nomclasseur As String
Dim LigneTotal As Integer
Dim DerLigne As Integer
Dim ws As Worksheet
 
 
'on désactive le raffraichissement de l'écran
Application.ScreenUpdating = False
 
Range("k1").Value = "BU"
 
'parcourir tous les ficiers du dossier
 
chdir "C:\Users\Gekko.wallst\OneDrive\Documents\Analyses FRTRAP\2018"
 
Nomclasseur = Dir("C:\Users\Gekko.wallst\OneDrive\Documents\Analyses FRTRAP\2018\*.xls")
'on boucle sur tous les classeurs excel
While Len(Nomclasseur) > 0
 
 
    Application.DisplayAlerts = False
 
    Workbooks.Open Nomclasseur 'pour ouvrir le classeur
 
        For Each ws In Sheets
        If ws.CodeName = "01" Or ws.CodeName = "02" Or ws.CodeName = "03" Or ws.CodeName = "04" Or ws.CodeName = "05" Or ws.CodeName = "06" Or ws.CodeName = "07" Or ws.CodeName = "08" Or ws.CodeName = "09" Or ws.CodeName = "010" Or ws.CodeName = "011" Or ws.CodeName = "012" Then
 
    LigneTotal = ActiveSheet.UsedRange.Rows.Count ' on compte le nombre de ligne totale
    Range("a3:j" & LigneTotal).Copy
    Workbooks("conso fichier.xlsm").Activate
    DerLigne = ActiveSheet.UsedRange.Rows.Count + 1 ' On recherche la dernière ligne vide de la feuille active du fichier conso fichier
    Range("a" & DerLigne).Select ' on se positionne sur la dernière ligne vide de la colonne A
    ActiveSheet.Paste
    Range("k" & DerLigne & ":k" & ActiveSheet.UsedRange.Rows.Count) = Nomclasseur
    Workbooks(Nomclasseur).Close
    Nomclasseur = Dir ' on passe au classeur suivant
    End If
 
    Next ws
 
 
Wend
 
Columns("k:k").Replace ".xls", ""
Application.ScreenUpdating = True
 
End Sub

[GekkoWallst]

J'ai essayé de cette façon pour récupérer les données sur les feuilles de chaque classeur, mais visiblement ça ne fonctionne pas correctement.

étrangement ça bloque à Workbooks(Nomclasseur).Close True..

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
Sub Consolidation()
 
Dim Nomclasseur As String
Dim LigneTotal As Integer
Dim DerLigne As Integer
Dim I As Integer
 
 
'on désactive le raffraichissement de l'écran
Application.ScreenUpdating = False
 
 
 
Range("k1").Value = "BU"
 
 
'parcourir tous les ficiers du dossier
 
chdir "C:\Users\Gekkowallstj\OneDrive\Documents\Analyses FRTRAP\2018"
 
Nomclasseur = Dir("C:\Users\Gekkowallstj\OneDrive\Documents\Analyses FRTRAP\2018\*.xls")
'on boucle sur tous les classeurs excel
While Len(Nomclasseur) > 0
 
 
    Application.DisplayAlerts = False 'désactive les boites de dialogue
 
    Workbooks.Open Nomclasseur 'pour ouvrir le classeur
 
        For I = 5 To 15
 
    LigneTotal = ActiveSheet.UsedRange.Rows.Count ' on compte le nombre de ligne totale
    Range("a3:j" & LigneTotal).Copy
    Workbooks("conso fichier.xlsm").Activate
    DerLigne = ActiveSheet.UsedRange.Rows.Count + 1 ' On recherche la dernière ligne vide de la feuille active du fichier conso fichier
    Range("a" & DerLigne).Select ' on se positionne sur la dernière ligne vide de la colonne A
    ActiveSheet.Paste
    Range("k" & DerLigne & ":k" & ActiveSheet.UsedRange.Rows.Count) = Nomclasseur
 
    Workbooks(Nomclasseur).Close True
    Nomclasseur = Dir ' on passe au classeur suivant
 
 
    Next I
 
 
Wend
 
Columns("k:k").Replace ".xls", "" 'on retire les extensions des fichiers
 
 
 
 
 
 
Application.ScreenUpdating = True
 
 
 
 
 
End Sub

Comment puis-je formuler mon code afin que je puisse récupérer les données des feuilles nommées "01" à "012" de chaque classeur ?


Merci d'avance pour votre aide :-)