Problème d’exécution "1004"

Version imprimable

Bonjour, à tous !

Grâce à l'aide d'un de vos collègues j'ai pu développer une macro qui interroge un répertoire pour en extraire des données contenues dans des fichiers excel de nombre inconnu.

Cette macro utilise le MSR.

J'encontre en revanche un petit souci ...

Jusqu’à présent je faisais tourner la macro sur le "Thiswoorkbook" et elle faisait des extractions sur la "Feuil1"
Pour un souci de pratique je voudrais qu'elle fasse une extraction sur la "Feuil2"
Je pensais que ça allait être relativement simple à faire, mais je n'ai vraiment pas réussi à la faire changer ...

Sauriez-vous comment je pourrais faire ce petit changement svp ??

Au passage je n'ai pas forcément compris toutes les lignes de cette macro si vous avez quelques explications je suis preneur :mrgreen:

Code originel :

Code:

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
Sub ParcourirDossier()
 
Dim FichierSélectionné As String
Dim NumFichier As Integer
Dim fs As FileDialog
Dim DossierSélectionné As Folder
 
    Application.CutCopyMode = False
    Application.ScreenUpdating = False
 
 
    Set FichierPrincipal = ThisWorkbook
    Set FeuilleCompil = FichierPrincipal.Sheets("Feuil1")
    Set fs = Application.FileDialog(msoFileDialogFolderPicker)
    fs.Title = "Selection du dossier à parcourir"
    fs.AllowMultiSelect = False
    fs.InitialFileName = Chemin
    fs.Show
    If fs.SelectedItems.Count < 1 Then Exit Sub
    Set fso = New FileSystemObject
    Set DossierSélectionné = fso.GetFolder(fs.SelectedItems(1))
 
    Call scan(DossierSélectionné)
 
End Sub
 
Sub scan(ByVal Dossier As Folder)
 
Dim NomFichier As String
Dim Classeur As Workbook
 
    For Each Fichier In Dossier.Files
        Select Case Right(Fichier, 3)
            Case "xls", "lsx", "lsm", "lsb"
                If Left(Fichier.Name, 1) <> "~" Then 'Permet d'exclure les fichier temporaires
                    Workbooks.Open Fichier
                    Set Classeur = ActiveWorkbook
 
                    Classeur.Sheets(2).Range("A1").CurrentRegion.Copy
 
                    ThisWorkbook.Sheets(1).Range("A1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
 
 
                    Classeur.Close False
                End If
        End Select
    Next Fichier
 
    For Each Sousdossier In Dossier.SubFolders
        Call scan(Sousdossier)
    Next
 
    Application.CutCopyMode = True
    Application.ScreenUpdating = True
 
End Sub

Code rectifié (Défectueux) :

Code:

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
Sub ParcourirDossier()
 
Dim FichierSélectionné As String
Dim NumFichier As Integer
Dim fs As FileDialog
Dim DossierSélectionné As Folder
 
    Application.CutCopyMode = False
    Application.ScreenUpdating = False
 
 
    Set FichierPrincipal = ThisWorkbook
    Set FeuilleCompil = FichierPrincipal.Sheets("Feuil2")
    Set fs = Application.FileDialog(msoFileDialogFolderPicker)
    fs.Title = "Selection du dossier à parcourir"
    fs.AllowMultiSelect = False
    fs.InitialFileName = Chemin
    fs.Show
    If fs.SelectedItems.Count < 1 Then Exit Sub
    Set fso = New FileSystemObject
    Set DossierSélectionné = fso.GetFolder(fs.SelectedItems(1))
 
    Call scan(DossierSélectionné)
 
End Sub
 
Sub scan(ByVal Dossier As Folder)
 
Dim NomFichier As String
Dim Classeur As Workbook
 
    For Each Fichier In Dossier.Files
        Select Case Right(Fichier, 3)
            Case "xls", "lsx", "lsm", "lsb"
                If Left(Fichier.Name, 1) <> "~" Then 'Permet d'exclure les fichier temporaires
                    Workbooks.Open Fichier
                    Set Classeur = ActiveWorkbook
 
                    Classeur.Sheets(2).Range("A1").CurrentRegion.Copy
 
                    ThisWorkbook.Sheets(2).Range("A1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
 
 
                    Classeur.Close False
                End If
        End Select
    Next Fichier
 
    For Each Sousdossier In Dossier.SubFolders
        Call scan(Sousdossier)
    Next
 
    Application.CutCopyMode = True
    Application.ScreenUpdating = True
 
End Sub

Merci d'avance pour vos réponses !

31/08/2020, 14h16
mfoxy

Bonjour,

À vue de nez,,et sans avoir tester, je dirais que la ligne incriminé est la 39, tu essaies de copier la feuille 2 de ton classeur cible, probablement inexistante dans celui-ci.

Code:

Classeur.Sheets(2).Range("A1").CurrentRegion

Devait rester

Code:

Classeur.Sheets(1).Range("A1").CurrentRegion
31/08/2020, 14h28
Philippe Tulliez

Bonjour,
Une feuille de calcul est un objet Worksheet qui fait partie de la collection Worksheets.
Le membre d'une collection peut être appelé soit par son numéro d'indice, exemple Worksheets(1) ou par son nom, exemple Worksheets("Chiffre d'affaires")
Sauf si c'est pour parcourir une collection, il est fortement déconseillé d'utiliser le numéro d'indice car celui-ci dépend de la position de la feuille dans le classeur.

Pour s'affranchir de toute modification du nom d'une feuille par l'utilisateur, il est hautement conseillé d'utiliser le CodeName de la feuille (voir ce billet VBA – CodeName d’une feuille Excel)

Pour info : Sheet est un objet feuille qui fait partie de la collection Sheets (cela peut-être une feuille de calcul, graphique ou macro). Dans la majeure partie des cas en VBA, on utilise des feuilles de calcul. Il est donc préférable d'utiliser l'objet Worksheet
31/08/2020, 14h51
TheHugoGua

Excuse moi j'ai oublié de spécifier mais je souhaiterais copié les cellules qui sont sur le feuille 2 pour les collés sur la feuille 2 de mon fichier de synthèse.

Bonjour,
Lorsque l'on copie des cellules il y a toujours une source et une cible. La syntaxe est toujours la même quelque soit l'endroit où se trouve la source et la cible, il suffit de préciser la parentalité complète de celles-ci, soit le classeur et la feuille.
Idéalement on prévoit deux variables objets de type Range (par exemple rngSource et rngTarget) où l'on précisera le classeur (Workbook) et la feuille (Worksheet) de chacun)

La syntaxe sera alors tout simplement

Code:

rngSource.Copy Destination:=rngTarget

Exemples de déclarations et assignations des variables à placer avant le code ci-dessus
Pour ces deux exemples, j'ai ajouté deux variables de type Worksheet pour définir les feuilles "cible" et "source"

Exemple 1 : La plage "source" et la cellule "cible" sont dans le même classeur (ici ThisWorkbook) mais dans des feuilles distinctes
Code:

1 2 3 4 5 6 7 8 9 10 11 12 ' Déclaration Dim shtSource As Worksheet ' Feuille source Dim shtTarget As Worksheet ' Feuille cible Dim rngSource As Range ' Plage source Dim rngTarget As Range ' Cellule cible ' Assignation With ThisWorkbook Set shtSource = .Worksheets("CA").Range("A1").CurrentRegion Set shtTarget = .Worksheets("Synthèse").Range("F8") End With Set rngSource = shtSource.Range("A1").CurrentRegion Set rngTarget = shtTarget.Range("F8")
Exemple 2 : La plage "source" et la cellule "cible" sont dans des classeurs différents
Code:

1 2 3 4 5 6 7 8 9 10 ' Déclaration Dim shtSource As Worksheet ' Feuille source Dim shtTarget As Worksheet ' Feuille cible Dim rngSource As Range ' Plage source Dim rngTarget As Range ' Cellule cible ' Assignation Set shtSource = Workbooks("Mes affaires.xlsx").Worksheets("CA").Range("A1").CurrentRegion Set shtTarget = ThisWorkbook.Worksheets("Synthèse").Range("F8") Set rngSource = shtSource.Range("A1").CurrentRegion Set rngTarget = shtTarget.Range("F8")
Attention, écrit de mémoire donc non testé