[VBA] Correction de code (copie feuille + définir nom)

antha

XLDnaute Occasionnel
Bonjour à tou(te)s,

Grâce à différents posts du forums et l'enregistreur de macros, j'ai réussi à bricoler une macro qui me copie une feuille de mon classeur, la renomme selon le contenu d'une cellule, copie les valeurs/formats/largeurs, créée une plage nommée.

Quelques petites questions :

1- est-il nécessaire d'épurer le code ? Je pense que oui, mais n'y connait rien :(

Edit : résolu, merci pierre Jean :)

2- comment faire pour que la nouvelle feuille créée soit insérée après la feuille initiale ?

Edit : Partiellement résolu, j'ai rajouté en fin de macro
Code:
ActiveSheet.Move After:=Sheets("nomdelafeuilleapreslaquellelaplacer")


3- ma plage nommée est définie de manière fixe. Est-il possible de traduire : =DECALER($A$1;EQUIV("Recap";$A:$A;0)-1;;15;40) en vba ?
J'ai cherché, mais entre les Range.offset, application.worksheet.function, je m'embrouille... je bloque sur (en admettant que ce soit bon:p) : range("A1").offset(application.WorksheetFunction.EQUIV("Recap",Columns("A:A"),0)
Je n'arrive pas à étendre en hauteur et largeur.

Edit : cela semble résolu, je m'en suis sorti de la façon suivante (en tapant la formule dans l'enregistreur):
Code:
    ActiveWorkbook.Names.Add Name:=ActiveSheet.Range("A5"), RefersToR1C1:= _
        "=OFFSET(R1C1,MATCH(""recap"",(c1),0)-1,,15,40)"

Si quelqu'un peut corriger si nécessaire :) merci!



Merci de votre aide! :)

Ci-joint le code et le fichier.

Code:
Sub Copie_mois()
'
' Macro enregistrée le 08/08/2008 par 3078431
    range("B4:AQ230").Select
    Selection.Copy
    Sheets.Add
    range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
         Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Name = ActiveSheet.range("A2")
        range("A200:AN214").Select
     ActiveWorkbook.Names.Add Name:=ActiveSheet.range("A2"), RefersToR1C1:= _
        "=R200C1:R214C40"
        With ActiveWindow
        .DisplayGridlines = False
        .DisplayZeros = False
      End With
      Cells(2,2).Select      
End Sub
 

Pièces jointes

  • planning.zip
    43.8 KB · Affichages: 41
  • planning.zip
    43.8 KB · Affichages: 44
  • planning.zip
    43.8 KB · Affichages: 42
Dernière édition:

pierrejean

XLDnaute Barbatruc
Re : [VBA] Correction de code (copie feuille + définir nom)

bonjour antha

Voila comment je l'aurais ecrite (j'ai du interpreter un peu pour nommer la plage car la range("A2") est vide

Code:
Sub Copie_mois()
'
' Macro enregistrée le 08/08/2008 par 3078431
Application.ScreenUpdating = False
    Range("B4:AQ230").Copy
    Sheets.Add
    Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    For n = 1 To 40
     ActiveSheet.Columns(n).ColumnWidth = Sheets("plg_pg").Columns(n).ColumnWidth
    Next n
    ActiveSheet.Name = ActiveSheet.Range("A2")
    ActiveWorkbook.Names.Add Name:=Format(Range("A1"), "mmmm") & "_" & Year(Range("A1")), RefersToLocal:= _
        "B200:AN214"
      With ActiveWindow
        .DisplayGridlines = False
        .DisplayZeros = False
      End With
      Cells(2, 2).Select
 Application.ScreenUpdating = True
 
End Sub
 

Pièces jointes

  • Planning.zip
    43.1 KB · Affichages: 35
  • Planning.zip
    43.1 KB · Affichages: 32
  • Planning.zip
    43.1 KB · Affichages: 31

antha

XLDnaute Occasionnel
Re : [VBA] Correction de code (copie feuille + définir nom)

Merci de cette 1ère réponse:)
En fait A2 correspond à B5 sur la feuille d'origine (=texte(B4;"mmmaa") mais en blanc sur blanc pour ne pas que cela se voit.
 

pierrejean

XLDnaute Barbatruc
Re : [VBA] Correction de code (copie feuille + définir nom)

Re

OK le blanc/blanc m'a induit en erreur

Code:
Sub Copie_mois()
'
' Macro enregistrée le 08/08/2008 par 3078431
Application.ScreenUpdating = False
    Range("B4:AQ230").Copy
    Sheets.Add
    Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    For n = 1 To 40
     ActiveSheet.Columns(n).ColumnWidth = Sheets("plg_pg").Columns(n).ColumnWidth
    Next n
    ActiveSheet.Name = ActiveSheet.Range("A2")
    ActiveWorkbook.Names.Add Name:=Range("A2"), RefersToLocal:=ActiveSheet.Name & "!B200:AN214"
      With ActiveWindow
        .DisplayGridlines = False
        .DisplayZeros = False
      End With
      Cells(2, 2).Select
 Application.ScreenUpdating = True
End Sub
 

Discussions similaires

Réponses
3
Affichages
564