erreur 1004 sur un simple Range ("A2").Select
Bonjour,
J'avoue ne pas trouver de réponse à mon problème qui, pourtant, doit être très simple !...
J'ai un fichier excel avec un onglet dans lequel j'ai un grand nombre de lignes. Je souhaite splitter cette feuille en 4 en ajoutant 4 nouvelles feuilles (R2_0, R2_1, R2_2 et R2_fin) que je déplacerai ensuite dans des fichiers séparés.
La première ligne de la feuille est dupliquée dans les 4 nouvelles feuilles.
Mais il ne faut pas découper le premier onglet n'importe où : il faut que ce soit approximativement 1/4 (ou 1/2 ou 3/4) du nb de lignes total et à un changement de valeur dans la colonne B.
exemple : supposons que la feuille fasse 100 lignes et qu'on ait les valeurs suivantes dans la colonne B des lignes 24 à 28 :
24 => AA
25 => AA
26 => AA
27 => AA
28 => BB
Alors la rupture du premier bloc désiré doit se situer à la ligne 28 : 100 lignes divisé par 4 = 25 lignes, je cherche ensuite la rupture et je trouve la ligne 28.
Tout fonctionne bien dans le code jusqu'à la copie du premier bloc de lignes :
Je sélectionne le bloc dans le premier onglet => OK
Je sélectionne l'onglet R2_0 => OK
Je veux sélectionner la cellule A2 => erreur 1004 !
Voici le code : (Je ne cherche pas à optimiser le 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
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
|
Sub division4parties()
Dim nbLignes As Integer ' nb de lignes dans le fichier
Worksheets(1).Activate
Range("A2").Select
nbLignes = Range("A2", Selection.End(xlDown)).Cells.Count
MsgBox "Nb de lignes total : " & nbLignes
' création de 4 onglets vides à la suite du premier onglet
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "R2_0"
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "R2_1"
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "R2_2"
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "R2_fin"
'copie de la ligne titre dans chacun des onglets créés
Sheets(1).Cells(1, 1).EntireRow.Copy
Sheets("R2_0").Select
Sheets("R2_0").Cells(1, 1).EntireRow.Select
ActiveSheet.Paste
Sheets(1).Cells(1, 1).EntireRow.Copy
Sheets("R2_1").Select
Sheets("R2_1").Cells(1, 1).EntireRow.Select
ActiveSheet.Paste
Sheets(1).Cells(1, 1).EntireRow.Copy
Sheets("R2_2").Select
Sheets("R2_2").Cells(1, 1).EntireRow.Select
ActiveSheet.Paste
Sheets(1).Cells(1, 1).EntireRow.Copy
Sheets("R2_fin").Select
Sheets("R2_fin").Cells(1, 1).EntireRow.Select
ActiveSheet.Paste
' on divise par 4
Dim taille_approx As Integer
taille_approx = nbLignes / 4
MsgBox "taille_approximative des blocs = " & taille_approx
' on recherche les changements dans la colonne B après chaque limites de taille
Dim i As Integer
Dim ind_separ1 As Integer
Dim ind_separ2 As Integer
Dim ind_separ3 As Integer
Dim ind_separ4 As Integer
Sheets(1).Select
indlig = taille_approx
For i = indlig + 1 To indlig + 100
If (Cells(i, 2) <> Cells(indlig, 2)) Then
ind_separ1 = i - 1
Exit For
End If
Next
indlig = 2 * taille_approx
For i = indlig + 1 To indlig + 100
If (Cells(i, 2) <> Cells(indlig, 2)) Then
ind_separ2 = i - 1
Exit For
End If
Next
indlig = 3 * taille_approx
For i = indlig + 1 To indlig + 100
If (Cells(i, 2) <> Cells(indlig, 2)) Then
ind_separ3 = i - 1
Exit For
End If
Next
MsgBox ("les débuts de parties sont les lignes 2 ; " & ind_separ1 + 1 & " ; " & ind_separ2 + 1 & " ; " & ind_separ3 + 1)
' on copie les parties dans des onglets séparés
Sheets(1).Select
MsgBox "Sélection partie 1 lignes 2 à " & ind_separ1
Rows("2:" & ind_separ1).Select
MsgBox "copie Sélection partie 1"
Selection.Copy
MsgBox "Sélection onglet R2_0"
Sheets("R2_0").Select
MsgBox "Sélection cellule A2"
Range("A2").Select 'cette ligne provoque une erreur 1004
MsgBox "paste"
ActiveSheet.Paste
MsgBox "partie 1 copiée"
End Sub |
