Discussion :

[Nathan_8569]

Bonjour,
Voici mon problème :
J'ai actuellement une feuille (nommée "Feuille_tableau") qui contient un tableau de 50 lignes.
Je voudrais séparer ce tableau en 50 lignes dans 50 feuilles.

Lorsque j'écris le code ci-dessous, les 50 lignes vont dans la feuille "Feuille_destination1", cependant je souhaiterais incrémenter les feuilles pour qu'à chaque boucle, "Feuille_destination1" devienne "Feuille_destination2" puis "Feuille_destination3" etc...

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
 
Dim b
Dim numero As Integer
nb_ligne = Sheets("Feuille1").Range("N10").Value
 
While numero < nb_ligne
   Sheets("Feuille_tableau").Activate
   Rows(numero).Select
   Selection.Copy
Sheets("Feuille_destination1").Activate
  Rows(b).Select
  Selection.PasteSpecial
  b = b + 1
numero = numero + 1
 
Wend

Merci d'avance de votre aide

Nathan

[pipout64]

Salut Nathan.

Essai ça.

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
Sub essai_VBA()
 
Dim i As Integer
Dim nb_ligne As Integer
Dim monClasseur As Workbook
Dim Feuille_tableau As Worksheet
Dim sheetTOcreate As Worksheet
 
Set monClasseur = Application.Workbooks.Item("Mon Classeur.xlsx")
Set Feuille_tableau = monClasseur.Worksheets.Item("Feuille_tableau")
 
nb_ligne = Feuille_tableau.UsedRange.Rows.Count
 
For i = nb_ligne To 1 Step -1
    Set sheetTOcreate = monClasseur.Worksheets.Add(After:=monClasseur.Worksheets.Item(monClasseur.Worksheets.Count))
    sheetTOcreate.Name = "Feuille_" & nb_ligne - (i - 1)
    Feuille_tableau.Rows(i).Copy Destination:=sheetTOcreate.Cells(1, 1) 'ou PasteSpecial si tu préfères
Next
 
End Sub

Si tu as besoin d'explications, n'hésite pas.

Si je peux me permettre, bien que je ne sois pas encore un grand manitou du VBA, il serait intéressant de bien déclarer tes variables et être le plus explicite possible dans les instructions.
Si c'est chiant d'écrire Application.workbooks.item..., je pense que ça vaut le coup de faire l'effort pour comprendre le langage objet même si j'en bave toujours autant pour la similitude entre le nom des objets et celui des classes...

Cordialement.

[Nathan_8569]

Merci beaucoup pour ton aide , le programme fonctionne parfaitement !

Si je ne suis pas très explicite dans les programmes que je fais c'est que j'ai commencé le VBA il y a deux semaines et que je tente beaucoup de chose sans trop savoir comment faire.
Je te promet quand même d'apprendre les instructions pour coder correctement .

Juste une dernière petite question :

Imaginons qu'il y ai un problème ou que les données changent, et que l'utilisateur du programme veut refaire le découpage du tableau, est-ce que tu sais comment supprimer les feuilles créées précédemment? (Parce que là le programme ne marche qu'une seul fois)

Merci encore !

[pipout64]

Essaie ça:

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
Sub essai_VBA()
 
Dim i As Integer
Dim nb_ligne As Integer
Dim Nb_Sheets As Integer
Dim monClasseur As Workbook
Dim Feuille_tableau As Worksheet
Dim sheetTOcreate As Worksheet
Dim choix_User As Integer
 
Set monClasseur = Application.Workbooks.Item("Mon Classeur.xlsx")
Set Feuille_tableau = monClasseur.Worksheets.Item("Feuille_tableau")
 
On Error GoTo errorHandler
 
choix_User = MsgBox(Prompt:="Voulez-vous supprimer toutes les feuilles et les recréer dans la foulée ?", Buttons:=vbYesNo)
Nb_Sheets = monClasseur.Worksheets.Count
 
Application.ScreenUpdating = False
If choix_User = 6 Then
    For i = Nb_Sheets To 1 Step -1
        Do While monClasseur.Worksheets.Item(i).Name <> "Feuille_tableau"
            Application.DisplayAlerts = False
            monClasseur.Worksheets(i).Delete
            Application.DisplayAlerts = True
            i = i - 1
        Loop
    Next
Application.ScreenUpdating = True
MsgBox "Toutes les feuilles ont été supprimées et vont être re-créées avec les nouvelles données de la feuille Feuille_tableau"
End If
 
Application.ScreenUpdating = False
nb_ligne = Feuille_tableau.UsedRange.Rows.Count
 
For i = nb_ligne To 1 Step -1
    Set sheetTOcreate = monClasseur.Worksheets.Add(After:=monClasseur.Worksheets.Item(monClasseur.Worksheets.Count))
    sheetTOcreate.Name = "Feuille_" & nb_ligne - (i - 1)
    Feuille_tableau.Rows(i).Copy Destination:=sheetTOcreate.Cells(1, 1) 'ou PasteSpecial si tu préfères
Next
 
Application.ScreenUpdating = True
Feuille_tableau.Activate
 
Exit Sub
errorHandler:  MsgBox "La macro a planté: veuillez faire le bon choix en début de procédure ou relancer la macro."
 
End Sub

Bonne après-midi !