Discussion :

[cbredeche]

BONJOUR
J'ai une macro dans mon onglet "00-recap" qui autorise a dupliqué une ligne sélectionné x fois avec les donnée mais je voudrais aussi dupliquer l'onglet associer et l' indicé avec une lettre

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
 
 
Sub test()
'Updateby Extendoffice 20160616
    Dim xCount As Integer
LableNumber:
    xCount = Application.InputBox("Nombres de ligne à copier", "macro copie de lignes", , , , , , 1)
    If xCount < 1 Then
        MsgBox "Entre un nombre superieur a 0", vbInformation, "macro copie de lignes"
        GoTo LableNumber
    End If
    ActiveCell.EntireRow.Copy
    Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(xCount, 0)).EntireRow.Insert Shift:=xlDown
    Application.CutCopyMode = False
End Sub

exemple LIGNE sélectionner COR_01_19 nom idem que l'onglet
la macro demande nombre de ligne exemple x2 la ligne prend le même non mais je voudrais quel indice avec une lettre
exemple
COR_01_19 A
COR_01_19 B
Et que mon onglet COR_01_19 soit aussi duplique avec les donne et soit renommé comme mes lignes
COR_01_19 A
COR_01_19 B

je vous joins mon fichier te mon code


merci de votre aide

[Patrice740]

Bonjour,

Poster sur plusieurs forums, sans en informer personne, est un manque de respect envers tous les bénévoles qui te consacrent de leur temps pour résoudre ton problème !
N'étant pas au courant, ils perdent leur temps sans connaître les réponses, souvent très intéressantes, des autres forums.
Pendant ce temps là, ils pourraient répondre à d'autres personnes qui eux aussi ont besoin d'aide.

Patrice

[cbredeche]

Désolée mais je poste sur 3 différent forum pour avoir plusieurs avis tout simplement
je ne vois pas de mal a cela
dorénavant je préviendrais que le post est diffuser sur d'autre forum
je m'en excuse
encore merci de votre aide

je me permet de solliciter plusieurs forum sur mon problème ci dessus "je tenais simplement vous informer car ci ma été reprocher dernierement " ce que je peux comprendre mais sur les 3 sites il y a Différente compétence encore merci a vous et a eux

[MarcelG]

Salut,

Je partage, comme beaucoup d'autres j'en suis sûr, l'avis de Patrice.
Agir ainsi signifie un manque de confiance vis à vis du Forum.
Le fréquentant depuis nombre d'années, je peux t'assurer qu'aucune question n'est en dehors de la capacité de tous ses membres.

D'autre part, il me semble avoir lu dans ton post des libellés ayant paru sur une autre discussion à laquelle j'ai moi-même répondu et pour laquelle j'attends toujours un retour.

Dans ces conditions,....

[cbredeche]

Je suis d’accord avec patrice et encore desolé du désagrément causé j'ai mis les autres post en terminer sur les autres forum
et pour le sujet auquel tu ma répondu je viens de terminer ce matin et j'allais te remercier des éléments

je suis encore désolé de vous avoir blessé ceci n'etait en aucun cas mon but j'ai une admiration sur votre savoir faire
je vous promets que cela ne ce reproduira pas

[Thautheme]

Bonjour le fil, bonjour le forum,

Si le nom des onglets est EXACTEMENT identique aux valeurs en colonne B de l'onglet 00-Recap, le code ci-dessous devrait fonctionner :

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
Sub test()
'Updateby Extendoffice 20160616
Dim xCount As Integer
Dim col As Integer
Dim O As Worksheet
 
On Error Resume Next
Set O = Worksheets(Cells(ActiveCell.Row, "B").Value)
If Err <> 0 Then
    Err.Clear
    MsgBox "La colonne B de la cellule sélectionnée ne contient pas un nom d'onglet existant !. Opération avortée."
    Exit Sub
End If
On Error GoTo 0
LableNumber:
xCount = Application.InputBox("Nombres de ligne à copier", "macro copie de lignes", , , , , , 1)
If xCount < 1 Then
    MsgBox "Entre un nombre superieur a 0", vbInformation, "macro copie de lignes"
    GoTo LableNumber
End If
col = 1
For x = 1 To xCount
    ActiveCell.EntireRow.Copy
    ActiveCell.Offset(x, 0).EntireRow.Insert Shift:=xlDown
    Cells(ActiveCell.Offset(x, 0).Row, "B").Value = ActiveCell.Value & " " & Split(Columns(col).Address(0, 0), ":")(0): col = col + 1
Next x
Application.CutCopyMode = False
col = xCount
For x = xCount To 1 Step -1
    O.Copy after:=O
    ActiveSheet.Name = O.Name & " " & Split(Columns(col).Address(0, 0), ":")(0): col = col - 1
Next x
End Sub

[cbredeche]

merci super cela fonctionne