Copie de cellules à partir d'un autre classeur

**sqltrysh** · 12/08/2014, 10h56

Bonjour,

J'ai une problématique de copie de cellules à partir d'un autre classeur et sur plusieurs feuilles.

J'ai pu déjà faire une boucle sur une feuille de l'autre classeur et j'aimerai rajouté une autre feuille voire plusieurs dans la même boucle ;
je vous mets en PJ le fichier source que j'ai et le fichier cible où se trouve ma macro.

l'enrichissement des différentes lignes de mon tableau Initial ; par exemple pour le mois de Janvier et le Client Manuf:
- % clients = (cellule E6 de la feuille Stock du fichier Source ) * 100 et concaténer avec %
- Montant moyen par ligne = cellule G6 de la feuille Stock du fichier Source arrondi à l'entier le plus proche
- % d’Avances sur factures = (cellule H6 de la feuille Focus du fichier Source ) * 100 et concaténer avec %
- Montants réglés =cellule G3 de la feuille Focus du fichier Source

les cellules vides sont également à enrichir mais je pense que si j'ai le mode opératoire pour celles-ci, ça devrait aller.

mon code est le 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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
Option Explicit
Private Sub cmdInsererMois_Click()
Dim nbMois As Integer
Dim i As Integer
    Application.ScreenUpdating = False
    nbMois = Month(Date)
    'met référence 20XX dans la cellule C1
   Range("C1") = "Référence " & Year(Date) - 1
   'met Objectif dans la cellule D1
   Range("D1").Select
   ActiveCell.FormulaR1C1 = "Objectif"
    'met evolution vs M-1 dans E1
   Range("E1").Select
   ActiveCell.FormulaR1C1 = "Evolution vs M-1"
    'insert le nombre de colonnes nécéssaires a partir de la colonne E
   Columns("E").Resize(, nbMois).Insert
 
    For i = 1 To nbMois
        With Cells(1, 4 + i)
            .Value = DateSerial(Year(Date), i, 1)
            .NumberFormat = "mmmm"
        End With
    Next
'End Sub
 
Dim monFichierSource As String
Dim l As Integer
Dim j As Integer
Dim wbk1 As Workbook
Dim wbk2 As Workbook
Dim mois As Integer
monFichierSource = "Source"
Set wbk1 = ThisWorkbook
Set wbk2 = Workbooks.Open(Filename:="D:\Documents and Settings\Bureau\" & monFichierSource & ".xlsx")
 
 
 
 ' Boucle sur les mois pour copier les cellules
 
 'Clients Par Catégorie
 
   For mois = 1 To Month(Date)
   For j = 5 To mois
   For i = 2 To 72
 wbk2.Sheets("stock").Select
 If Cells(i, 3) = "Vetements" Then
 wbk1.Worksheets(1).Cells(37, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 5).Value * 100, 2) & "%"
 wbk1.Worksheets(1).Cells(38, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 7).Value, 0)
 ElseIf Cells(i, 3) = "Chaussures" Then
 wbk1.Worksheets(1).Cells(9, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 5).Value * 100, 2) & "%"
 wbk1.Worksheets(1).Cells(10, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 7).Value, 0)
 ElseIf Cells(i, 3) = "Produits" Then
 wbk1.Worksheets(1).Cells(23, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 5).Value * 100, 2) & "%"
 wbk1.Worksheets(1).Cells(24, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 7).Value, 0)
 ElseIf Cells(i, 3) = "Cosmetique" Then
 wbk1.Worksheets(1).Cells(30, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 5).Value * 100, 2) & "%"
 wbk1.Worksheets(1).Cells(31, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 7).Value, 0)
 ElseIf Cells(i, 3) = "Manuf" Then
 wbk1.Worksheets(1).Cells(2, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 5).Value * 100, 2) & "%"
  wbk1.Worksheets(1).Cells(3, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 7).Value, 0)
 ElseIf Cells(i, 3) = "Phyto" Then
 wbk1.Worksheets(1).Cells(16, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 5).Value * 100, 2) & "%"
 wbk1.Worksheets(1).Cells(17, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 7).Value, 0)
 
 
  'wbk2.Sheets("focus").Select
 'If Cells(i, 3) = "Chaussure" Then
 'wbk1.Worksheets(1).Cells(13, j).Value = Round(wbk2.Worksheets("focus").Cells(i, 8).Value * 100, 2) & "%"
 'wbk1.Worksheets(1).Cells(14, j).Value = Round(wbk2.Worksheets("focus").Cells(i, 7).Value, 0)
 'ElseIf Cells(i, 3) = "Manuf" Then
 'wbk1.Worksheets(1).Cells(6, j).Value = Round(wbk2.Worksheets("focus").Cells(i, 8).Value * 100, 2) & "%"
 'wbk1.Worksheets(1).Cells(7, j).Value = Round(wbk2.Worksheets("focus").Cells(i, 7).Value, 0)
 
j = j + 1
 
 
  End If
Next i
Next j
Next mois
 
 
 
 
Windows("TEST.xlsm").Activate
End Sub

La partie en commentaire est la partie que j'aimerai rajouter à ma boucle sans gêner celle qui s'effectue déjà.

Merci pour vos retours

**Thautheme** · 12/08/2014, 11h36

Bonjour Sqltrysh, bonjour le forum

Je regarde ton code et je ne comprend pas :
• Private Sub cmdInsererMois_Click() : j'ai pas trouvé de bouton ? Click correspond normalement à un bouton.
• Range("C1") = "Référence " & Year(Date) - 1 : de quel onglet, Initial, Final ?
Je sais que ça n'a pas trop de rapport avec ta requête mais si je ne comprends pas j'ai du mal à aller de l'avant...

**Menhir** · 12/08/2014, 11h46

En code VBA, il est déconseillé d'utiliser des Select autant que faire se peut.
Ca complexifie le code et ça ralenti son exécution.

Plutôt qu'écrire :

Code :

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

1
2
   Range("D1").Select
   ActiveCell.FormulaR1C1 = "Objectif"

Tu devrais écrire :

Code :

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

   Range("D1").FormulaR1C1 = "Objectif"

Pour répondre à ta question, pour atteindre la cellule d'une autre feuille que la feuille active, on utilise la syntaxe :

Code :

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

Worksheets("MaFeuille").Range("A1")

En remplaçant "MaFeuille" par le nom d'onglet ou une variable.

Pour atteindre la feuille d'un autre classeur, on utilise la syntaxe :

Code :

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

Workbooks("MonClasseur).Worksheets("MaFeuille")

Bien sûr, puisque VBA est un langage objet, ces deux syntaxes sont gigognes.

**sqltrysh** · 12/08/2014, 11h54

Merci Thautheme de te pencher sur mon sujet ;

pour ta première question je ne savais pas que click correspondait à un bouton

( désolé je suis novice en vba) ; j'ai juste donné un nom comme ça ;

Pour la deuxième question , il s'agit de l'onglet "initial" car l'onglet "Final" est juste un exemple de ce que j'aimerai obtenir en résultat.
Les cellules vides sont également à enrichir mais je pense que si j'ai le modop pour récupérer les données dans deux feuilles de l'autre classeur alors je pourrais récupérer sur les dizaines que j'ai.

Merci

Merci Menhir pour ton retour,

je prendrai en compte tes optimisations ;

je comprends comment aller d'une feuille à l'autre et d'une cellule à l'autre mais le problème est que quand je le fais ma boucle for ne fonctionne pas comme il se doit ; elle me sélectionne des cellules qu'il ne faut pas ; et c'est là que réside mon problème.

Donc comment faire cette boucle sachant qu'il y a plusieurs feuilles d'un classeur différent avec des lignes i pas forcément les mêmes sur ces feuilles?

Merci encore

**Menhir** · 12/08/2014, 12h06

Envoyé par sqltrysh

je prendrai en compte tes optimisations ;

Les premières lignes de mon messages ne sont pas seulement une optimisation, c'est la moitié de la réponse à ton problème.

je comprends comment aller d'une feuille à l'autre et d'une cellule à l'autre

Non. C'est justement tout l'objet de ce que tu appelles une "optimisation".
Dans VBA Excel, quand on code proprement, on ne "va" pas d'une feuille à l'autre (méthodes Select et Activate) mais on accède simplement aux données de chaque feuille, en lecture ou écriture, en incluant ces feuilles dans la syntaxe des commandes.

Par exemple, si je veut mettre le contenu de la cellule A1 de Feuille1 dans A1 de feuille2, on écrit :

Code :

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

Worksheets("Feuille2").Range("A1").Value = Worksheets("Feuille1").Range("A1").Value

mais le problème est que quand je le fais ma boucle for ne fonctionne pas comme il se doit ; elle me sélectionne des cellules qu'il ne faut pas ; et c'est là que réside mon problème.

Tu dis que ton code ne fait pas ce que tu souhaites mais tu ne décris pas ce que tu voudrais qu'il fasse EXACTEMENT.

En plus, des boucles "For to" il y en a plusieurs dans ce que tu présentes. Montre la partie de code qui prose problème et, avant de la copier ici, prends la peine de la nettoyer un peu.

**Thautheme** · 12/08/2014, 12h07

Bonjour le fil, bonjour le forum,

Peut-être comme ça (j'ai commenté les lignes que j'avais changé/ajouté) :

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
Option Explicit
Private Sub cmdInsererMois_Click()
Dim Wbk1 As Workbook
Dim OD As Object 'déclare la variable OD (Onglet Destination)
Dim NBMois As Integer
Dim I As Integer
Dim Wbk2 As Workbook
Dim OS As Object 'déflare la variabe OS (Onglet Source)
Dim Mois As Integer
Dim j As Integer
 
Application.ScreenUpdating = False
Set Wbk1 = ThisWorkbook
Set OD = Wbk1.Sheets(1) 'définit l'onglet Destination OD
NBMois = Month(Date)
'met référence 20XX dans la cellule C1
OD.Range("C1") = "Référence " & Year(Date) - 1
'met Objectif dans la cellule D1
OD.Range("D1").Value = "Objectif"
'met evolution vs M-1 dans E1
OD.Range("E1").Value = "Evolution vs M-1"
'insert le nombre de colonnes nécéssaires a partir de la colonne E
OD.Columns("E").Resize(, NBMois).Insert
For I = 1 To NBMois
    With OD.Cells(1, 4 + I)
        .Value = DateSerial(Year(Date), I, 1)
        .NumberFormat = "mmmm"
    End With
Next I
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set Wbk2 = Workbooks("Source.xlsx") 'définit le classeur Wbk2 (génère une erreur si ce classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'efface l'erreur
    Workbooks.Open ("D:\Documents and Settings\Bureau\Source.xlsx") 'ouvre le classeur "Source.xlsx"
    Set Wbk2 = ActiveWorkbook 'définit le classeur Wbk2
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OS = Wbk2.Sheets("Stock") 'définit l'onglet source OS
' Boucle sur les mois pour copier les cellules
'Clients Par Catégorie
For Mois = 1 To Month(Date)
    For j = 5 To Mois
        For I = 2 To 72
            If OS.Cells(I, 3) = "Vetements" Then
                OD.Cells(37, j).Value = Round(OS.Cells(I, 5).Value * 100, 2) & "%"
                OD.Cells(38, j).Value = Round(OS.Cells(I, 7).Value, 0)
            ElseIf OS.Cells(I, 3) = "Chaussures" Then
                OD.Cells(9, j).Value = Round(OS.Cells(I, 5).Value * 100, 2) & "%"
                OD.Cells(10, j).Value = Round(OS.Cells(I, 7).Value, 0)
            ElseIf OS.Cells(I, 3) = "Produits" Then
                OD.Cells(23, j).Value = Round(OS.Cells(I, 5).Value * 100, 2) & "%"
                OD.Cells(24, j).Value = Round(OS.Cells(I, 7).Value, 0)
            ElseIf OS.Cells(I, 3) = "Cosmetique" Then
                OD.Cells(30, j).Value = Round(OS.Cells(I, 5).Value * 100, 2) & "%"
                OD.Cells(31, j).Value = Round(OS.Cells(I, 7).Value, 0)
            ElseIf OS.Cells(I, 3) = "Manuf" Then
                OD.Cells(2, j).Value = Round(OS.Cells(I, 5).Value * 100, 2) & "%"
                OD.Cells(3, j).Value = Round(OS.Cells(I, 7).Value, 0)
            ElseIf OS.Cells(I, 3) = "Phyto" Then
                OD.Cells(16, j).Value = Round(OS.Cells(I, 5).Value * 100, 2) & "%"
                OD.Cells(17, j).Value = Round(OS.Cells(I, 7).Value, 0)
            End If
            Set OS = Wbk2.Sheets("focus") 'redéfinit l'onglet source OS
            If OS.Cells(I, 3) = "Chaussure" Then
                OD.Cells(13, j).Value = Round(OS.Cells(I, 8).Value * 100, 2) & "%"
                OD.Cells(14, j).Value = Round(OS.Cells(I, 7).Value, 0)
            ElseIf OS.Cells(I, 3) = "Manuf" Then
                OD.Cells(6, j).Value = Round(OS.Cells(I, 8).Value * 100, 2) & "%"
                OD.Cells(7, j).Value = Round(OS.Cells(I, 7).Value, 0)
                j = j + 1
            End If
        Next I
    Next j
Next Mois
Wbk1.Activate
Application.ScreenUpdating = True
End Sub

**sqltrysh** · 12/08/2014, 13h37

Merci Menhir pour le retour : ma problématique est de copier des cellules de différentes feuilles d'un classeur appelé "Source" vers la feuille "Initial" de mon classeur "Test" ;
le code que je vous ai mis fonctionne quand on est sur la feuille "stock", et donc la boucle fait ce que je veux et mon problème est de faire dans cette même boucle les opérations de copie de cellules mais à partir de la feuille "focus" de l'autre classeur d'où la partie en commentaire dans mon code de départ.

@Menhir : J'aimerais faire une boucle partant du classeur Source et des différentes feuilles ; par exemple :
*Feuille Stock : pour le mois de Janvier et la catégorie Vêtement, copier la cellule du taux correspondant sur la feuille Initial de mon classeur Test dans la cellule de Janvier %clients et ainsi de suite pour toutes mes catégories et ce jusqu'au mois en cours ;
d'où mes trois "For" .
* Feuille Focus : dans la même boucle, pour le mois de Janvier et la catégorie Chaussure, copier la cellule H2 et la coller sur la feuille Initial de mon classeur Test dans Janvier % d’Avances sur factures et ce jusqu'au mois en cours

Si il y a une autre manière de procéder, alors je suis preneuse

La feuille Finale de mon classeur Test ressemble à ce que je veux obtenir en sortie

Merci Thautheme pour ce code, je le teste et je reviens vers toi

Thautheme, le code que tu as écrit est exactement le même que j'ai fait au départ ( mis à part les lignes de codes d'erreurs que tu as rajoutées).
L'as-tu testé ?
il y a toujours un problème dans la boucle ; je pense que c'est la définition de mon I qui pose problème mais je ne comprends pas pourquoi.

**Thautheme** · 12/08/2014, 15h16

Bonjour le fil, bonjour le forum,

Oui tu as raison mais je n'ai pas compris comment boucler avec des pages nommées..

**sqltrysh** · 12/08/2014, 16h19

Thautheme et Menhir : un peu plus explicitement

ma boucle :

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
 
For mois = 1 To Month(Date) 'pour dire que le mois commence en janvier jusqu'au mois en cours
   For j = 5 To mois 'pour débuter la copie dans le fichier test à partir de la colonne 5 correspondant à janvier jusqu'au mois en cours
   For i = 2 To 72 'pour moi le problème est là, il faut revoir la définition du i qui correspond pour moi aux itérations sur les lignes du fichiers source 
 wbk2.Sheets("stock").Select
 If Cells(i, 3) = "Vetements" Then
 wbk1.Worksheets(1).Cells(37, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 5).Value * 100, 2) & "%"
 wbk1.Worksheets(1).Cells(38, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 7).Value, 0)
 ElseIf Cells(i, 3) = "Chaussures" Then
 wbk1.Worksheets(1).Cells(9, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 5).Value * 100, 2) & "%"
 wbk1.Worksheets(1).Cells(10, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 7).Value, 0)
 ElseIf Cells(i, 3) = "Produits" Then
 wbk1.Worksheets(1).Cells(23, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 5).Value * 100, 2) & "%"
 wbk1.Worksheets(1).Cells(24, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 7).Value, 0)
 ElseIf Cells(i, 3) = "Cosmetique" Then
 wbk1.Worksheets(1).Cells(30, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 5).Value * 100, 2) & "%"
 wbk1.Worksheets(1).Cells(31, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 7).Value, 0)
 ElseIf Cells(i, 3) = "Manuf" Then
 wbk1.Worksheets(1).Cells(2, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 5).Value * 100, 2) & "%"
  wbk1.Worksheets(1).Cells(3, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 7).Value, 0)
 ElseIf Cells(i, 3) = "Phyto" Then
 wbk1.Worksheets(1).Cells(16, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 5).Value * 100, 2) & "%"
 wbk1.Worksheets(1).Cells(17, j).Value = Round(wbk2.Worksheets("stock").Cells(i, 7).Value, 0)
 
 
 ' wbk2.Sheets("focus").Select
 'If Cells(i, 3) = "Chaussure" Then
 'wbk1.Worksheets(1).Cells(13, j).Value = Round(wbk2.Worksheets("focus").Cells(i, 8).Value * 100, 2) & "%"
 'wbk1.Worksheets(1).Cells(14, j).Value = Round(wbk2.Worksheets("focus").Cells(i, 7).Value, 0)
 'ElseIf Cells(i, 3) = "Manuf" Then
 'wbk1.Worksheets(1).Cells(6, j).Value = Round(wbk2.Worksheets("focus").Cells(i, 8).Value * 100, 2) & "%"
 'wbk1.Worksheets(1).Cells(7, j).Value = Round(wbk2.Worksheets("focus").Cells(i, 7).Value, 0)
 
j = j + 1
 
 
  End If
Next i
Next j
Next mois
 
 
 
 
Windows("TEST.xlsm").Activate
End Sub

peut-être faut-il penser le code autrement, j'ai eu cette idée dès le départ ; idée fausse peut-être ; les lignes en commentaire dans mon code sont celles qui sélectionne la deuxième feuille pour faire les copies de cellules et que j'aimerai intégrer à ma boucle ou faut-il faire une autre boucle pour la deuxième feuille?

Merci pour vos réponses