Création d'une boucle/même opération/même cellule

Spider123 - 29 août 2012 à 19:52
 Spider123 - 30 août 2012 à 09:47
Bonjour à tous
Tout d'abord, merci pour votre site, étant débutant en VBA, j'ai trouvé énormément d'informations très utiles.
Mon problème est le suivant.
Sur ma première feuille (appelée Fiche1) un tableau comportant 150 lignes et une dizaine de colonnes remplies de texte
Mon objectif:
Sur une feuille 2 (appelée"vierge") un questionnaire type.
Je voudrais copier la feuille vierge, la coller sur un nouvel onglet, la nommée "Question 1" et coller à différents endroits des cellules de la Feuil1 puis, arrivé à la fin de la dernière cellule remplie de la ligne, recommencer à copier copier les cellules sur ce nouvel onglet jusqu'à ma 150ème ligne.

J'ai trouvé la solution pour les copier coller et création des différentes feuilles, mais je n'arrive pas à orienter VBA pour qu'il reproduise à chaque fin de ligne la même opération avec les cellules 150lignes suivantes

Ci-après ce que j'ai déja fait:
Sub création_feuille()

End Sub
'je créé les différents onglets
Dim i, z
z = InputBox("Nombre de copies", "Copie")
For i = 1 To 151
Sheets("Vierge").Copy After:=Sheets(i)
ActiveSheet.Name = "Question " & i
Next i
End

Sub copy_fusion()
'je selectionne les feuilles
Sheets("Standards 2015").Select
Sheets("vierge").Select
Application.EnableEvents = False
'je realise les copier/coller
With Worksheets("Standards 2015")
.Range("A2").Copy Worksheets("vierge").Range("G1")
.Range("C2").Copy Worksheets("vierge").Range("H1")
.Range("D2").Copy Worksheets("vierge").Range("H2")
.Range("H2").Copy Worksheets("vierge").Range("A1")
.Range("J2").Copy Worksheets("vierge").Range("K1")
.Range("N2").Copy Worksheets("vierge").Range("A3")

End With
'je fusionne les lignes nécessaires
With Worksheets("vierge")
.Range("G1:G2").Merge
.Range("H1:J1").Merge
.Range("H2:J2").Merge
.Range("A1:E2").Merge
.Range("K1:K2").Merge
.Range("A3:G8").Merge
End With
Application.EnableEvents = True
End Sub

Merci beaucoup de votre temps consacré

Merci!!
Spider Cochonou 123

2 réponses

cs_Jack
Messages postés
14007
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
78
29 août 2012 à 22:09
Salut et bienvenu

Première chose : Quand tu colles du code, utilise la coloration syntaxique (3ème icone à droite) = plus facile à relire et conserve l'indentation du code (espaces devant les lignes)

Déjà, dans ton code, quelque chose m'intrigue :
'je créé les différents onglets
Dim i, z
z = InputBox("Nombre de copies", "Copie")
For i = 1 To 151
    Sheets("Vierge").Copy After:=Sheets(i)
    ActiveSheet.Name = "Question " & i
Next i 
Dans ce code, tu demandes le nombre de copies, dans 'z', mais tu ne t'en sers pas ensuite ...
Ne serait-ce dans la boucle For-Next qu'il y a un souci ?

Petite amélioration : Au lieu de désigner l'index de la Sheet du After, mieux vaut regarder le nombre de feuilles présentes dans le classeur :
    Sheets("Vierge").Copy After:= Sheets(ActiveWorkbook.Sheets.Count)

Ton problème, donc, est de répéter le programme de la Sub copy_fusion dans chacune des 'copies' que tu as créé auparavant ?
Pour ce faire, il te faut fournir :
## A ## la feuille sur laquelle opérer à la Sub , donc passer un paramètre à la Sub.
Soit tu passes le nom de la feuille, soit tu passes l'objet qui référence la feuille :
-1- Nom de la feuille
Il te suffit de déclarer ceci :
Sub copy_fusion(NomFeuille As String)
puis, dans cette Sub, de remplacer :
Worksheets("vierge")
par
Worksheets(NomFeuille)
Pour l'appelle de la Sub :
Call copy_fusion("Question 4012")
-2- l'objet :
Cela sous-entend que tu as préparé l'objet.
    Dim oFeuille As WorkSheet
    ' ... la boucle For
    Sheets("vierge").Copy After:  =Sheets(ActiveWorkbook.Sheets.Count)
    Set oFeuille =  ActiveSheet
    oFeuille.Name = "Question " & Cstr(i)
Il te faut déclarer ceci :
Sub copy_fusion(NewFeuille As WorkSheet)
puis, dans cette Sub, de remplacer :
Worksheets("vierge")
par
NewFeuille
Pour l'appelle de la Sub :
Call copy_fusion(oFeuille)

## B ## Modifier quelque peu la Sub en question.
En effet, Range("A2") ne sera plus valable pour la seconde feuille.
Je devine qu'il faut passer à A3, c'est à dire à la ligne du dessous.
Ca, c'est facile avec OffSet - regarde dans l'aide.
Il suffit donc de donner un OffSet de ligne de 0 pour la 1ère feuille, 1 pour la 2snd, etc, donc 1 de moins que ta variable 'i' (dans le For-Next)
Donc, il faut aussi passer ce paramètre dans la Sub.
Il faut donc modifier sa déclaration ainsi :
Sub copy_fusion(NomFeuille As String, _
                DecalageLigne As Long)
+ utiliser la variable DecalageLigne dans le OffSet que tu ajouteras
+ lancer la Sub comme ça :
Call copy_fusion("Question 4012", i - 1)
(exemple avec le nom de la feuille, mais pareil si tu choisis le crée un objet)

Amuse-toi bien.

Vala
Jack, =fr MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
0
Super, merci pour ton travail, je m'y mets dès maintenant
Merci!!
Spider Cochonou 123
0