Macro de copie

Version imprimable

Macro de copie

Bonjour tout le monde,

Je débute dans le VBA, et j'ai écrit une petite macro qui malheureusement ne fonctionne pas.

Je veux simplement remplir x fois un tableau avec des cellules provenant d'une autre worksheet. Chaque tableau correspond à une unique ligne. Le problème étant que les cellules que je copie ne sont pas contiguës. Je ne peux donc pas faire de range.

Voici mon code :

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
Sub CopieColleFacturesMS()
 
 
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim colonne As Integer
Dim ligneDeDepart As Integer
Dim nbreDeCopies As Integer
Dim ligneDArrivee As Integer
 
 
'Définition de la colonne de destination de copie
colonne = 3
ligneDeDepart = 3
nbreDeCopies = 10
ligneDArrivee = ligneDeDepart + (29 * nbreDeCopies)
 
'Initialisation de la première ligne à copier
 k = 6
'Boucle de copie des tableaux: le premier tableau commence à la ligne 3, et chaque tableau est espacé par 29 lignes.
For i = ligneDeDepart To ligneDArrivee Step 29
 
 
    With Worksheets("7.Etiquettes")
 
        'Boucle d'incrémentation de ligne du tableau à remplir
        For j = i To i + 12 Step 1   
            .Cells(j, colonne) = Worksheets("1. Patrimoine").Cells(k, 5)
            .Cells(j, colonne) = Worksheets("1. Patrimoine").Cells(k, 4)
            .Cells(j, colonne) = Worksheets("1. Patrimoine").Cells(k, 1)
            .Cells(j, colonne) = Worksheets("1. Patrimoine").Cells(k, 3)
            .Cells(j, colonne) = Worksheets("1. Patrimoine").Cells(k, 8)
            .Cells(j, colonne) = Worksheets("1. Patrimoine").Cells(k, 9)
            .Cells(j, colonne) = Worksheets("1. Patrimoine").Cells(k, 10)
            .Cells(j, colonne) = Worksheets("1. Patrimoine").Cells(k, 7)
            .Cells(j, colonne) = Worksheets("1. Patrimoine").Cells(k, 14)
            .Cells(j, colonne) = Worksheets("1. Patrimoine").Cells(k, 13)
            .Cells(j, colonne) = Worksheets("1. Patrimoine").Cells(k, 34)
            .Cells(j, colonne) = Worksheets("1. Patrimoine").Cells(k, 35)
            .Cells(j, colonne) = Worksheets("1. Patrimoine").Cells(k, 41)
 
        Next j
 
    End With
    k = k + 1
Next i
 
 
End Sub

Aujourd'hui, lorsque je lance cette macro, j'ai l'impression de voir très rapidement mes tableaux se remplir mais le contenu des cellules disparait aussitôt.

Merci d'avance

Je ne sais pas ce que tu veux faire, mais tu ne varie pas la variable colonne, c'est pourquoi tu auras toujours la dernière valeur

Code:

.Cells(j, colonne) = Worksheets("1. Patrimoine").Cells(k, 41)

Tu peux néanmoins essayer ce code s'il fait ce que tu souhaite

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
Sub CopieColleFacturesMS()
Dim i As Long, k As Long, igneDeDepart As Long, ligneDArrivee As Long
Dim colonne As Integer, nbreDeCopies As Integer
 
Application.ScreenUpdating = False
'Définition de la colonne de destination de copie
colonne = 3
ligneDeDepart = 3
nbreDeCopies = 10
ligneDArrivee = ligneDeDepart + (29 * nbreDeCopies)
'Initialisation de la première ligne à copier
k = 6
'Boucle de copie des tableaux: le premier tableau commence à la ligne 3, et chaque tableau est espacé par 29 lignes.
With Worksheets("7.Etiquettes")
    For i = ligneDeDepart To ligneDArrivee Step 29
        .Range(.Cells(i, colonne), .Cells(i + 12, colonne)).Value = Worksheets("1. Patrimoine").Cells(k, 5)
        .Range(.Cells(i, colonne + 1), .Cells(i + 12, colonne + 1)).Value = Worksheets("1. Patrimoine").Cells(k, 4)
        .Range(.Cells(i, colonne + 2), .Cells(i + 12, colonne + 2)).Value = Worksheets("1. Patrimoine").Cells(k, 1)
        .Range(.Cells(i, colonne + 3), .Cells(i + 12, colonne + 3)).Value = Worksheets("1. Patrimoine").Cells(k, 3)
        .Range(.Cells(i, colonne + 4), .Cells(i + 12, colonne + 4)).Value = Worksheets("1. Patrimoine").Cells(k, 8)
        .Range(.Cells(i, colonne + 5), .Cells(i + 12, colonne + 5)).Value = Worksheets("1. Patrimoine").Cells(k, 9)
        .Range(.Cells(i, colonne + 6), .Cells(i + 12, colonne + 6)).Value = Worksheets("1. Patrimoine").Cells(k, 10)
        .Range(.Cells(i, colonne + 7), .Cells(i + 12, colonne + 7)).Value = Worksheets("1. Patrimoine").Cells(k, 7)
        .Range(.Cells(i, colonne + 8), .Cells(i + 12, colonne + 8)).Value = Worksheets("1. Patrimoine").Cells(k, 14)
        .Range(.Cells(i, colonne + 9), .Cells(i + 12, colonne + 9)).Value = Worksheets("1. Patrimoine").Cells(k, 13)
        .Range(.Cells(i, colonne + 10), .Cells(i + 12, colonne + 10)).Value = Worksheets("1. Patrimoine").Cells(k, 34)
        .Range(.Cells(i, colonne + 11), .Cells(i + 12, colonne + 11)).Value = Worksheets("1. Patrimoine").Cells(k, 35)
        .Range(.Cells(i, colonne + 12), .Cells(i + 12, colonne + 12)).Value = Worksheets("1. Patrimoine").Cells(k, 41)
        k = k + 1
    Next i
End With
End Sub

28/01/2011, 17h25
Schnouf00

Merci pour ta réponse.
J'ai mal du m'exprimer. Je voudrais que ça soit coller sur x(=nombreDeCopies) tableaux qui contiennent 12 lignes mais une unique colonne.

Le résultat aurait la forme (à titre d'exemple pour la forme)

Dans la worksheet 7:

EDIT: je précise que les les cellules de worksheet1 de la ligne 6 que je veux récupérer ne sont pas contigues ce qui rend impossible l'utilisation d'un range à mon sens.

Tableau 1
A6 de worksheet 1
E6 de worksheet 1
C6 de worksheet 1
H6 de worksheet 1
...

Tableau 2
A7 de worksheet 1
E7 de worksheet 1
C7 de worksheet 1
H7 de worksheet 1
...

Tableau x
A(5+x) de worksheet 1
E(5+x) de worksheet 1
C(5+x) de worksheet 1
H(5+x) de worksheet 1

Ton script fonctionne bien mais construit qu'un tableau.

Je comprends mal pourquoi mon script ne fonctionne pas.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub CopieColleFacturesMSf()
Dim i As Long, k As Long, ligneDeDepart As Long, ligneDArrivee As Long
Dim Colonne As Integer, nbreDeCopies As Integer
Dim j As Byte
Dim TabCol
 
Application.ScreenUpdating = False
Colonne = 3: ligneDeDepart = 3: nbreDeCopies = 10: ligneDArrivee = ligneDeDepart + (29 * nbreDeCopies)
k = 6: TabCol = Array(4, 1, 3, 8, 9, 10, 7, 14, 13, 34, 35, 41)
With Worksheets("7.Etiquettes")
   For i = ligneDeDepart To ligneDArrivee Step 29
      For j = LBound(TabCol) To UBound(TabCol)
         .Cells(i + j - LBound(TabCol), Colonne).Value = Worksheets("1. Patrimoine").Cells(k, TabCol(j))
      Next j
      k = k + 1
   Next i
End With
End Sub

01/02/2011, 11h13
Schnouf00

Désolé pour le temps de réponse mais merci beaucoup, ton script fonctionne !

Merci encore!