Discussion :

[lesjno35]

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 :

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
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

[Pierre Fauconnier]

Salut.

Sur un classeur que j'ai créé pour l'occasion, ton code fonctionne sans soucis. Cela dit, dommage que tu ne cherches pas à l'optimiser.

[lesjno35]

Salut.

Sur un classeur que j'ai créé pour l'occasion, ton code fonctionne sans soucis. Cela dit, dommage que tu ne cherches pas à l'optimiser.

Merci Pierre d'avoir pris la peine de faire l'essai. Le fait que le code fonctionne chez vous m'a fait trouver la cause de mon problème : La macro était enregistrée au niveau de la feuille. Je l'ai déplacé au niveau worksheet et là tout va bien !

Je peux maintenant continuer !
Merci encore !

[Pierre Fauconnier]

Désolé. Je n'ai pas pensé que le problème pouvait venir de là, puisque j'avais placé le code dans un module standard...

Tant mieux que la solution ait été trouvée

Bon we