Copier Coller vers nouveau classeur

**Crome** · 11/01/2021, 16h28

Bonjour à toutes et tous,
Deuxième post ici, le premier m'avait bien aidé ^^
Je ne maîtrise pas encore bien les copier/coller avec les histoires de wb et ws actifs ou non.

But du code : parcourir une série de .xlsx, récupérer 2 colonnes (A et F) dans une certaine feuille qui a toujours le meme nom (vol pompé 24h), les coller dans un nouveau classeur, passer au fichier suivant.
J'ai cru comprendre que lrosuqu'on créait un fichier avec workbook.add, celui-ci devenait le classeur actif par défaut. Avec le code ci dessous, j'ai une erreur sur .copy à la ligne 17 :

Erreur :

Erreur 1004 : erreur définie par l'application ou par l'objet

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
Sub bouclefor2()
    Dim fso As Object, rep As Object, FichierATraite As Object
    Dim range1 As Range, range2 As Range
    Dim wbData As Workbook, wsData As Worksheet
    Dim wbPréparé As Workbook, wsPréparé As Worksheet
 
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set rep = fso.GetFolder(Cells(6, 3).Value) 'chemin répertoire
 
    For Each FichierATraite In rep.Files
        If InStr(FichierATraite.Name, ".xls") > 0 Then
 
            Set wbData = Workbooks.Open(FichierATraite)
            'TEST Set wsData = wbData.Sheets("Vol pompé 24h")
            'TEST wsData.Range("A:A,F:F").Copy
 
            Sheets("Vol pompé 24h").Range("A:A,F:F").Copy
 
            Set wbPréparé = Workbooks.Add
                With wbPréparé
                    .Title = "Dates et Débits (bilan24h, m3) issus de" & FichierATraite.Name
                    .SaveAs Filename:=rep & "\" & "PREP_" & FichierATraite.Name
                End With
 
            ActiveSheet.Paste Destination:=Range("A1")
 
            wbData.Close SaveChanges:=False
            wbPreparé.Close SaveChanges:=True
 
            Set wbData = Nothing ' Libérer la ressource
            Set wbPreparé = Nothing
 
        End If
    Next FichierATraite
End Sub

J'arrive pourtant a copier coller des données d'une feuille à une autre, la création du nouveau workbook fonctionne bien, la boucle parcours bien chaque fichier dans mon repertoire, mais impossible de copier mes collones dans les nouveaux fichiers.
Merci d'avance pour vos réponses

**Jean-Philippe André** · 11/01/2021, 16h39

Salut,

pour t'assurer de "taper" sur la bonne feuille, il faut indiquer le classeur par sécurité

Code :

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

 wbData.Worksheets("Vol pompé 24h").Range("A:A,F:F").Copy

A noter que donner des noms accentués à ta variable, c'est déconseillé (mon qwerty te remercie)

**Crome** · 11/01/2021, 16h50

Bonjour Jean-Philippe, merci de ta première réponse

En effet, c'est pour ça qu'au début j'avais utilisé la syntaxe

Code :

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

1
2
3
Set wbData = Workbooks.Open(FichierATraite)
            Set wsData = wbData.Sheets("Vol pompé 24h")
            wsData.Range("A:A,F:F").Copy

qui me semblait correcte, mais ne fonctionnant pas j'ai récupéré mon bout de code qui fonctionnait pour copier d'une feuille à une autre.

Et d'accord, j'ai remplacé tous mes préparé par des prepare ^^

L'erreur doit certainement être synthaxique. Je vois mon code comme : j'ouvre mon classeur, c'est mon classeur actif. J'ouvre ma feuille, c'est ma feuille active. Je copy les valeurs qui m'interessent avec Range.
Puis, je crée un nouveau classeur. Il devient mon classeur actif. J'y colle ma selection.
Lorsqu'un classeur est actif, sa première feuille est elle active par défaut ?
Sinon, il faudrait peut etre rajouté après la création du classeur une ligne du genre :

Set wsPrepare = ActiveWorksheets()

?

**Jean-Philippe André** · 11/01/2021, 17h00

La feuille active d'un classeur actif, ca peut être n'importe laquelle.
Tu peux faire un essai en créant un classeur, activer la seconde feuille, enregistrer et fermer le classeur, en le réouvrant ca sera toujours la seconde feuille active

Coder en utilisant la notion de classeur actif ou feuille active, ce n'est pas la bonne façon de faire.

Tu codes directement avec le nom du classeur et le nom de la feuille, sans avoir besoin d'activer ou de désactiver.

L'utilisation du ActiveXX ne se fait que dans de très rares occasions.

Prend l'habitude, dès l'instant que tu codes, à passer volontairement par la chaîne complète classeur.feuille.range(), et évite le plus possible d'avoir des

Code :

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

fso.GetFolder(Cells(6, 3).Value)

qui se baladent.

Ce n'est pas parce que cela fonctionne ici que c'est une façon correcte de code

**Crome** · 11/01/2021, 17h31

D'accord donc dans mon cas, en fait mes 2 classeurs (celui duquel je prend les données et celui vers lequel je les collent) sont tous les deux actifs si je puis dire.
La seule chose qui va changer, c'est la syntaxe qui permet de dire :
"je copie quoi, dans quelle feuille, et vers quelle feuille"

Je suis obligé de passer par le cells().Value, car c'est une macro destinée à un novice (un peu comme moi) qui aura juste a copier/collé son chemin d'accès pour exécuter la macro.
Mais du coup je ne comprend pas pourquoi

Code :

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

1
2
3
4
5
6
7
8
9
            wbData.Worksheets("Vol pompé 24h").Range("A:A,F:F").Copy
 
            Set wbPrepare = Workbooks.Add
                With wbPrepare 
                    .Title = "Dates et Débits (bilan24h, m3) issus de" & FichierATraite.Name
                    .SaveAs Filename:=rep & "\" & "PREP_" & FichierATraite.Name
                End With
 
            wbPrepare .Paste Destination:=Range("A1")

ne fonctionne pas, on a bien le départ et la destination pourtant

**Jean-Philippe André** · 11/01/2021, 18h00

tu as un Range() tout seul

la syntaxe complète la plus efficace serait selon moi :

Code :

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

wbData.Worksheets("Vol pompé 24h").Range("A:A,F:F").Copy Destination:=wbPrepare.Range("A1")

voir si tu as besoin de fournir "A:A" en plage de destination

**Crome** · 11/01/2021, 18h12

Je viens de finir par trouver, j'ai presque la même chose que vous ...

Code :

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

wsData.Range("A:A,F:F").Copy wsPrepare.Range("A1")

Passer une journée entière là-dessus, à la fin on a envie de se taper la tête contre un mur.

Merci pour ton aide cher Jean-Philippe, et peut-être à bientôt.

TOPO pour les futurs codeurs qui se poseraient la meme question :

étape 1 : Dimensionner vos 4 éléments : Wb et Ws de départ, Wb et Ws d'arrivée. NB: Ws à partir de Wb, c'est mieux
étape 2 : Entrez votre itinéraire :

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

NomWsDepart.Range("VotrePlage1").Copy NomWsArrivée.Range("VotrePlage2")

**fcmanchester92** · 31/01/2022, 13h39

Bonjour,

Je relance ce post parce qu'il me semble que mon problème est assez similaire au précédent mais je n'arrive pas à le résoudre seul.

Objectif du code: boucler sur les fichiers d'un dossier et faire des copier-coller les uns en dessous des autres dans des nouveaux classeurs

Problème: Mon code plante sur la 2ème grande boucle à la ligne 143:

Code :

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

MEF.Worksheets("ANOMALIE_VARIATION").Range(Cells(1, 1), Cells(Fin_Row, Fin_Col)).Copy Destination:=NOUVEAU.Worksheets("Feuil1").Range(Cells(Fin_Row_nouv + 2, 1), Cells(Fin_Row_nouv + 2, 1))

J'ai une erreur 1004 qui apparaît alors que j'essaie pourtant d'utiliser le chemin entier plutôt que les workbooks actifs. Je ne comprends vraiment pas d'où vient l'erreur sachant qu'une ligne similaire fonctionne un peu avant dans le code à la ligne 109:

Code :

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

MEF.Worksheets("ANOMALIE_VARIATION").Range(Cells(1, 1), Cells(Fin_Row, Fin_Col)).Copy Destination:=NOUVEAU.Worksheets("Feuil1").Range("A1")

Je vous remercie par avance de votre aide!

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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
Sub Mise_en_forme()
 
'préparatoire
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
'définition des variables
Dim MonChemin As String, MonFichier As String
Dim MEF As Workbook
Dim NOUVEAU As Workbook
 
'chemin d'accès
MonChemin = Range("CHEMIN")
MonChemin = InputBox("Veuillez saisir le chemin d'accès", "REPERTOIRE SOURCE", Range("CHEMIN"))
Range("CHEMIN") = MonChemin
MonFichier = Dir(MonChemin & "\*")
 
'Boucle sur les fichiers du dossier
'----------------------------------
c = 0 'compteur
 
Do While MonFichier <> ""
 
If Left(MonFichier, 22) = "relances_qualitatives_" Then
 
        Workbooks.Open Filename:=MonChemin & "\" & MonFichier, ReadOnly:=False, UpdateLinks:=False
        Set MEF = ActiveWorkbook 'déclaration du fichier à mettre en forme
        c = c + 1
 
    'Taille du tableau
    MEF.Worksheets("ANOMALIE_VARIATION").Activate
 
    'insérer une colonne
    Range("A:A").Insert
    Range("A1") = "Code_bce"
 
    Range("A1").Select
    Fin_Col = Selection.End(xlToRight).Column
    Range("B1").Select
    Fin_Row = Selection.End(xlDown).Row
 
    'écrire le code de la série
    code = Split(MonFichier, "_")
    Range(Cells(2, 1), Cells(Fin_Row, 1)).Select
    Selection = code(3)
 
    'Mise en forme
    Range(Cells(1, 1), Cells(1, Fin_Col)).Select 'coloration de la première ligne
 
    Selection.Font.Bold = True
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
 
    Range(Cells(1, 1), Cells(Fin_Col, Fin_Col)).EntireColumn.Select
    Range(Cells(1, 1), Cells(Fin_Col, Fin_Col)).EntireColumn.AutoFit
 
    MEF.Save
    MEF.Close
 
 End If
 
MonFichier = Dir()
 
Loop
 
 
MonFichier = Dir(MonChemin & "\*")
CIB_prec = ""
CIB_act = ""
n = 0 'compte le nombre de fichiers portant sur le même CIB
c = 0 'compte le nombre de fichier
 
Do While MonFichier <> ""
 
If Left(MonFichier, 22) = "relances_qualitatives_" Then
 
    CIB = Split(MonFichier, "_")
    CIB_act = CIB(2)
    c = c + 1
 
    Set MEF = Workbooks.Open(Filename:=MonChemin & "\" & MonFichier, ReadOnly:=False, UpdateLinks:=False) 'déclaration du fichier à mettre en forme
 
    If CIB_act <> CIB_prec Then
 
        'on ferme le nouveau classeur précédent (sauf lors de la première boucle car il n'existe pas)
        If n <> 0 Then
            NOUVEAU.SaveAs (MonChemin & "\Classeur" & CStr(c))
            NOUVEAU.Close
        End If
 
        n = 1
 
 
        Set NOUVEAU = Workbooks.Add
 
        'Taille du tableau
        MEF.Worksheets("ANOMALIE_VARIATION").Activate
 
        Range("A1").Select
        Fin_Col = Selection.End(xlToRight).Column
        Range("B1").Select
        Fin_Row = Selection.End(xlDown).Row
 
        MEF.Worksheets("ANOMALIE_VARIATION").Range(Cells(1, 1), Cells(Fin_Row, Fin_Col)).Copy Destination:=NOUVEAU.Worksheets("Feuil1").Range("A1")
 
    Else
 
        n = n + 1
 
        'Taille du tableau
        MEF.Worksheets("ANOMALIE_VARIATION").Activate
 
        Range("A1").Select
        Fin_Col = Selection.End(xlToRight).Column
        Range("B1").Select
        Fin_Row = Selection.End(xlDown).Row
 
        NOUVEAU.Worksheets("Feuil1").Activate
        Range("A1").Select
        Fin_Col_nouv = Selection.End(xlToRight).Column
 
        d = 0
        m = 1
        Fin_Row_nouv = 1
 
        Do While m < n
 
        'Taille du tableau
        NOUVEAU.Worksheets("Feuil1").Activate
        Cells(Fin_Row_nouv + d, 1).Select
        Fin_Row_nouv = Selection.End(xlDown).Row
 
        d = 2
        m = m + 1
 
        Loop
 
        MEF.Worksheets("ANOMALIE_VARIATION").Range(Cells(1, 1), Cells(Fin_Row, Fin_Col)).Copy Destination:=NOUVEAU.Worksheets("Feuil1").Range(Cells(Fin_Row_nouv + 2, 1), Cells(Fin_Row_nouv + 2, 1))
 
    End If
 
MEF.Close
 
End If
 
CIB_prec = CIB(2)
MonFichier = Dir()
 
Loop
 
NOUVEAU.SaveAs (MonChemin & "\Classeur" & CStr(c))
NOUVEAU.Close
 
 
'message d'info et fin
MsgBox c & " fichiers traités"
Application.Goto Range("A1"), True
Range("A4").Select
 
End Sub