Etendre macro à l'ensemble d'une selection

**nonodudu77** · 04/11/2014, 17h37

Bonjour,

J'ai réalisé une macro afin que mes données ici mon tableau 1 "ligne 1 à 12" me génère automatiquement de multiples tableaux (un tableau pour chaque ligne de mon 1er tableau).

Actuellement, je dois me mettre sur la cellule A1 du tableaux et cliquer sur le bouton GO pour générer le second tableau pour la ligne 1 et répéter cette action pour les ligne suivante.

J'aurai souhaiter pouvoir sélectionner l'ensemble de mon tableaux et appuyer une seule fois sur mon bouton et que ça me génère l'ensemble des second tableaux.

Je vous joins mon fichier.

J'espère que j'ai été clairet que vous pourrez m'aider.

Merci par avance

**keygen08** · 04/11/2014, 18h45

Bonjour
Il faut initialiser une boucle du genre

Code :

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

1
2
3
4
5
6
7
8
Sub Macro7()
Dim cell As Range
For Each cell In Range("a1:a" & Cells(Rows.Count, 1).End(xlUp).Row)
 
votre code
 
Next cell
end sub

Tous le reste du code devrait ressembler plutôt a ceci

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
    cell.Offset(27, 0) = "Souhaite une étude personnalisée"
    cell.Offset(2, 0) = "Nom"
    cell.Offset(2, 0) = "Prenom"
    cell.Offset(2, 0) = "Email"
    cell.Offset(2, 0) = "Tel"
    cell.Offset(2, 0) = "CP"
    cell.Offset(2, 0) = "Imposition"
    cell.Offset(2, 0) = "Age"
    cell.Offset(2, 0) = "Source"
    cell.Offset(0, 1) = "Needocs"
    cell.Offset(-43, 0).Copy cell.Offset(29, 0).Range("A1")
    cell.Offset(-29, 1).Copy cell.Offset(31, -1).Range("A1")

Comme vous le voyer, il y a un sacré nettoyage a faire

**nonodudu77** · 12/11/2014, 13h49

Bonjour,

Merci pour votre retour.

J'ai fait un peu de nettoyage mais je rencontre un problème. Lorsque je lance la macro, j'ai erreur d'execution 1004.

Je ne comprend pas mon erreur.

~~Je vous joints mon fichier.~~
Fichier joint dans vos discussions

Merci par avance pour votre aide.

**SfJ5Rpw8** · 12/11/2014, 14h07

Bonjour,

sur qu'elle ligne l'erreur ? montre-nous le morceau de code concerné entre balises : [CODE][/CODE]

**nonodudu77** · 12/11/2014, 14h19

Bonjour,

Il s'agit de cette partie de code

Code :

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

cell.Offset(-43, 0).Copy cell.Offset(29, 0).Range("A1")

Mon code au complet 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
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
Sub Macro7()
Dim cell As Range
For Each cell In Range("a1:a12" & Cells(Rows.Count, 1).End(xlUp).Row)
'
' Macro7 Macro
'
 
'
    ActiveCell.Offset(27, 0) = "Souhaite une étude personnalisée"
    ActiveCell.Offset(2, 0) = "Nom"
    ActiveCell.Offset(2, 0) = "Prenom"
    ActiveCell.Offset(2, 0) = "Email"
    ActiveCell.Offset(2, 0) = "Tel"
    ActiveCell.Offset(2, 0) = "CP"
    ActiveCell.Offset(2, 0) = "Imposition"
    ActiveCell.Offset(2, 0) = "Age"
    ActiveCell.Offset(2, 0) = "Source"
    ActiveCell.Offset(0, 1) = "Needocs"
    cell.Offset(-43, 0).Copy cell.Offset(29, 0).Range("A1")
    cell.Offset(-29, 1).Copy cell.Offset(31, -1).Range("A1")
    cell.Offset(-31, 2).Copy cell.Offset(33, -2).Range("A1")
    cell.Offset(-31, 2).Copy cell.Offset(33, -2).Range("A1")
    cell.Offset(-33, 3).Copy cell.Offset(35, -3).Range("A1")
    cell.Offset(-35, 4).Copy cell.Offset(37, -4).Range("A1")
    cell.Offset(-37, 6).Copy cell.Offset(41, -6).Range("A1")
 
 
    ActiveWindow.SmallScroll Down:=-27
    ActiveCell.Offset(-41, 8).Range("A1").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.SmallScroll Down:=12
    ActiveCell.Offset(39, -8).Range("A1").Select
    ActiveSheet.Paste
 
    ActiveCell.Offset(-12, -1).Range("A1:B17").Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveWindow.SmallScroll Down:=-3
    ActiveCell.Offset(-4, 0).Rows("1:21").EntireRow.Select
    ActiveCell.Offset(16, 0).Range("A1").Activate
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-17, 0).Range("A1").Select
    ActiveWindow.SmallScroll Down:=-27
 
Next cell
End Sub

**SfJ5Rpw8** · 12/11/2014, 14h29

Travailler avec ActiveCell et source d'ennui....

abuser de la propriété offset rend difficile la compréhension du code ...

vérifie que tu ne sort pas des limite de ta feuille , affiche par exemple l'adresse de cells ... dans fenêtre visualisation variable en mode débeugage... ou par un msgbox :

Code :

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