Bonjour toutes et tous,
Je me mets de plus en plus aux macros en glanant çà et là des bouts de code. Ma macro copie des données d'une feuille vers une feuille vierge. Mon problème, c'est qu'une fois que j'ai donné un titre à mon nouveau classeur via le "Inputbox" ce n'est pas pris en compte au moment de l'enregistrement.
Et mon deuxième problème est que je souhaite nommer automatiquement mon nouvel onglet du même nom que la feuille créée. Merci pour votre aide.
Gerson
Je me mets de plus en plus aux macros en glanant çà et là des bouts de code. Ma macro copie des données d'une feuille vers une feuille vierge. Mon problème, c'est qu'une fois que j'ai donné un titre à mon nouveau classeur via le "Inputbox" ce n'est pas pris en compte au moment de l'enregistrement.
Et mon deuxième problème est que je souhaite nommer automatiquement mon nouvel onglet du même nom que la feuille créée. Merci pour votre aide.
Code:
Sub Extraction() '
Dim WB As Workbook
Dim Nom_Ext As String
Set WB = Application.Workbooks.Add
Nom = InputBox("Veuillez saisir votre titre", "Titre :")
If Nom = "" Then MsgBox "Abandon": Exit Sub
Nom_Ext = Nom & ".xls"
ActiveWindow.Caption = Nom_Ext
Windows("ClasseurTest.xls").Activate
Range("A2:I55").Select
Selection.Copy
WB.Windows(1).Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'on met en forme
Range("G5:I8").Select
Selection.Interior.ColorIndex = 15
Range("C11:F11").Select
Selection.Interior.ColorIndex = 15
Range("A15:D15").Select
Selection.Interior.ColorIndex = 15
Range("G15:H15").Select
Selection.Interior.ColorIndex = 15
Range("A16:I43").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="0"
Selection.FormatConditions(1).Font.ColorIndex = 2
Range("A1:I54").Select
Range("A54").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Rows("1:1").Select
Selection.RowHeight = 45
ActiveWindow.DisplayGridlines = False
Range("A6").Select
End Sub
Gerson