Discussion :

[Lulu3344]

Bonjour,

Je souhaiterais créer un bouton pour copier coller la première page d'une feuille Excel en page 2 puis page 3, page x ...
Par exemple j'ai besoin que les 3 premières pages de ma feuille soit identique, je clique sur le bouton et il me propose d'insérer le nombre de page sur lequel je souhaite effectuer l'opération (ici 3).
Peut être qu'il me faudrait également un bouton pour annuler l'opération.

J'ai commencé à regarder mais cela ne fonctionne que pour la page 2.

Code :

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

1
2
3
4
5
6
7
8
9
Sub Bouton11_Cliquer()
 
    Sheets("feuille1").Range("A1:R37").Copy
    ' page 2
    Range("A38").Select
    Selection.PasteSpecial Paste:=xlValues
    Range("A38").Select
    Selection.PasteSpecial Paste:=xlFormats
End sub

Merci d'avance pour votre aide

[eric4459]

Salut,
Essayes avec çà

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Copie_Feuille()
Dim i As Integer
Dim a As Variant
Dim b As Variant
 
 a = InputBox("Quelle Feuille voulez-vous copier ? (Insérer Nom de la Feuille)")
 
 b = InputBox("Combien de Feuilles voulez-vous ajouter ?")
 
 
    For i = 1 To b
       Sheets(a).Copy After:=Sheets(Sheets.Count)
    Next i
End Sub

Insères une forme sur ta feuille et avec un clic droit sur cette forme sélectionne "Affecter une Macro" et choisi dans la liste la macro "Copie_Feuille"
Eric

[Lulu3344]

Merci pour ta réponse Eric.

Ce n'est pas tout fait ce que je voulais faire.

Je voulais sélectionner la page 1 (ligne 1 à 37) d'une feuille et la reporter en page 2 (ligne 38 à 74) puis page 3 (ligne 75 à 111) etc.... toujours dans la même feuille en choisissant le nombre de page sur lequel je veux reporter la première page (ligne 1 à 37).

Je sais pas si j'ai été clair dans mes explications.

[eric4459]

Salut LuLu
Voila qui devrait faire ton affaire

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
Sub Copie_Cellules_Feuilles()
Dim Fl1 As Worksheet
Dim i As Integer
Dim NbLigne As Integer
Dim a As Variant
Dim PlCel As Range
Set Fl1 = ThisWorkbook.Sheets("Sheet1") 'Feuille où se trouvent les données à copier
Set PlCel = Fl1.Range("A1")
 
 a = InputBox("Nombre de copie ?")
 
With Fl1
NbLigne = .Cells(.Rows.Count, 1).End(xlUp).Row  ' On compte le nombre de ligne de la colonne A
End With
 
Range(PlCel.Offset(0, 0), PlCel.Offset(0, 0).End(xlToRight).End(xlDown)).Copy 'On copie toute la plage de données
 
    For i = 1 To a
       PlCel.Offset((NbLigne * i), 0).PasteSpecial 'On colle autant de fois que désiré (variable "a")
    Next i
 
End Sub

Une variante si tu veux appliquer à une feuille non connue

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
Sub Copie_Cellules_Feuilles_Variante()
Dim Fl1 As Worksheet
Dim i As Integer
Dim NbLigne As Integer
Dim a As Variant
Dim PlCel As Range
Set Fl1 = ActiveSheet 'Feuille où se trouvent les données à copier
Set PlCel = Fl1.Range("A1")
 
 a = InputBox("Nombre de copie ?")
 
With Fl1
NbLigne = .Cells(.Rows.Count, 1).End(xlUp).Row  ' On compte le nombre de ligne de la colonne A
End With
 
Range(PlCel.Offset(0, 0), PlCel.Offset(0, 0).End(xlToRight).End(xlDown)).Copy
 
    For i = 1 To a
       PlCel.Offset((NbLigne * i), 0).PasteSpecial
    Next i
 
End Sub

Dis moi si c'est ok pour toi
Eric

[Lulu3344]

J'ai un message d'erreur : "Erreur d'exécution '1004' Le collage ne peut pas être effectué car les zones copier et de collage sont de tailles différentes.
Veuillez effectuer l'une des actions suivantes : cliquer sur une cellule puis coller ou sélectionner une zone rectangulaire de taille identique puis coller."

[eric4459]

Rebonjour,
Je viens de tester à nouveau et pas de problèmes pour moi, voici le fichier

Copie feuille en N fois.xlsm

Eric

[Lulu3344]

Désolé mais ca ne fonctionne toujours pas pour moi.

[Al__22]

Je ne comprends pas pourquoi la solution de Eric ne fonctionne pas mais essaye ceci :

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
Dim a as Variant
Dim b as Variant
 
a = InputBox("Nombre de copie ?")
b = InputBox("Dans quelle feuille ? (Nom de la feuille)")
nbLigne = IIf(Sheets(b).Range("A1") = "", 1, 38)
 
For i = 1 to a
 
Sheets(b).Range("Ton range à copier").Copy
 
Sheets(b).Range("A" & nbLigne).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
 
nbLigne = nbLigne + 37
Next i

[eric4459]

Bonjour Lulu,
Peut-être y-a-t-il des cellules fusionnées dans ta feuille?
Eric

[Lulu3344]

Merci à vous. Ca fonctionne.

Effectivement, il y a des cellules fusionnées.