Macro creation et collage dans nouvelle feuille

Bonjour,

Je souhaite automatiser une tache. Je veux pouvoir coller des cellule d'une feuille "listing" vers une feuille "modèle". Crée un nouvelle onglet, le renommer "Palette 1" par exemple. Puis copier les données mise en forme de "modèle" vers le nouvelle onglet "Palette1".

Ma macro fonction bien jusqu'au collage dans le nouvelle onglet "Palette 1". La macro s'appuie sur Feuil2 par exemple mais comme c'est la 3eme ou 4eme fois que je lui demande ce n'est plus Feuil2 mais Feuil3.

Comment faire pour que la macro crée les onglets sans bloquer sur le nom de la feuille ?

Sub Macro2()
'
' Macro2 Macro
'

'Copie des cellule vers modele

    Range("A1:A5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("modele").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("Feuil1").Select
    Range("A6:A10").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("modele").Select
    Range("B1").Select
    ActiveSheet.Paste
    Sheets("Feuil1").Select
    Range("A11:A15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("modele").Select
    Range("C1").Select
    ActiveSheet.Paste
    Sheets("Feuil1").Select
    Range("A16:A20").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("modele").Select
    Range("D1").Select
    ActiveSheet.Paste
    Sheets("Feuil1").Select

    'Ajout nouvelle feuille

    Sheets.Add After:=ActiveSheet

    'Renommer nouvelle feuille

    Sheets("Feuil1").Select
    Range("B2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Feuil3").Select
    Sheets("Feuil3").Name = "palette 1"

    'Copier de modele vers nouvelle feuille

    Sheets("modele").Select
    Range("A1:D5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("palette 1").Select
    ActiveSheet.Paste
    Range("C35").Select

    'Supprimer cellule de feuille modele

    Sheets("modele").Select
    Application.CutCopyMode = False
    Selection.ClearContents

    'Retour sur feuil1

    Sheets("Feuil1").Select
    Range("D11").Select
End Sub

Bonsoir,

Sub Macro2()
'
'Copie des cellule vers modele

    Sheets("Feuil1").Range("A1:A5").Copy destination:= Sheets("modele").Range("A1")
    Sheets("Feuil1").Range("A6:A10").Copy destination:= Sheets("modele").Range("B1")
    Sheets("Feuil1").Range("A11:A15").Copy destination:= Sheets("modele").Range("C1")
    Sheets("Feuil1").Range("A16:A20").Copy destination:= Sheets("modele").Range("D1")

    'Ajout nouvelle feuille
 Sheets.Add After:=ActiveSheet

 'Renommer nouvelle feuille
Activesheet.name = "Palette 1"

    'Copier de modele vers nouvelle feuille

    Sheets("modele").Range("A1:D5").Copy destination:= Sheets("Palette 1").Range("A1")

    'Supprimer cellule de feuille modele
Sheets("modele").Range("A1").CurrentRegion.ClearContents

    'Retour sur feuil1
Sheets("Feuil1").Select

End Sub

Sur la fin, j'ai un peu perdu le fil de ce que tu voulais faire ...

Je n'ai pas testé mais cela devrait faire la même chose que ton code, au moins sur une bonne partie du programme. Tu dois pouvoir t'inspirer de ça.

La feuille modele ne servant à rien, tu dois même pouvoir faire ça :

Sub Macro2()
'
 'Ajout nouvelle feuille
 Sheets.Add After:=ActiveSheet

 'Renommer nouvelle feuille
Activesheet.name = "Palette 1"

'Copie des cellule vers modele

    Sheets("Feuil1").Range("A1:A5").Copy destination:= Sheets("Palette 1").Range("A1")
    Sheets("Feuil1").Range("A6:A10").Copy destination:= Sheets("Palette 1").Range("B1")
    Sheets("Feuil1").Range("A11:A15").Copy destination:= Sheets("Palette 1").Range("C1")
    Sheets("Feuil1").Range("A16:A20").Copy destination:= Sheets("Palette 1").Range("D1")

Sheets("Feuil1").Select

End Sub

Bonjour,

Merci pour le code. Il est clairement plus lisible que le mien (enregistreur de macro). J'essaye d'adapté tous ca car le nom "Palette 1" est changeant, 1, 2, 3, 4, ...

Mais c'est deja un super début.

Merci

Hello, essaie ça sinon.
Ça teste l'existence d'une feuille nommé "Palette " et un nombre derrière. Ça créé une feuille nommée palette et un chiffre au dessus de ton dernier utilisé, et ça colle tes données dedans.

Sub Macro2()
Dim sh As String

For i = 1 To Sheets.Count
    On Error Resume Next
    If IsError(Sheets("Palette " & i)) Then
        On Error GoTo 0

        Application.DisplayAlerts = False
        Sheets.Add After:=ActiveSheet

        'Renommer nouvelle feuille
        ActiveSheet.Name = "Palette " & i
        sh = ActiveSheet.Name
    End If
Next

'Copie des cellule vers feuille palette
With Sheets("Feuil1")
    .Range("A1:A5").Copy Destination:=Sheets(sh).Range("A1")
    .Range("A6:A10").Copy Destination:=Sheets(sh).Range("B1")
    .Range("A11:A15").Copy Destination:=Sheets(sh).Range("C1")
    .Range("A16:A20").Copy Destination:=Sheets(sh).Range("D1")
    .Select
End With
Application.DisplayAlerts = True

End Sub

Si des experts voient une méthode plus propre pour faire cela, je suis preneur !